R Shiny 使用模块并从列表中选取输入时缺少反应性

Question

1. 我有一个 R Shiny 模块，它执行线性回归，将 data.table 作为输入。
2. 我试图在应用程序中使用此模块，我试图将 data.table 的名称作为反应性输入。 我正在使用下面的代码。
3. 错误是它并没有被证明是反应性的——尝试将输入从 iris 更改为 mtcars，你会发现回归变量的 select 选项没有改变（我无法弄清楚我遗漏了什么）。
4. 请注意，下面是一个可重现的代码（原始代码太大，将从 excel 个文件中获取名称）。
   请帮忙。

应用代码

#### ---- REQUIRED LIBRARIES -----

library(shiny)
library(readxl)
library(dplyr)
library(xts)




# START OF UI ----

ui <- navbarPage(title = "study",
                 inverse=TRUE,
                 
                 tabPanel("Data Inputs",
                         
                            tabPanel("Regression",
                                     
                                     
                                     uiOutput("dummy.input"),
                                     Linear.Regression.UI("dummy")
                                     
                      
                          )#end of tabsPanel Regressions
                 )#end of tabPanel Data Inputs
                 
               
                 
)#end of navbarPage




# START OF SERVER -----



server <- function(input, output, session, data.tibble){
  
  
  dummy.list <- reactive(list(iris= iris, mtcars = mtcars))
  
  output$dummy.input <- renderUI({
    selectInput(inputId = "dummy.input.select",
                label = "Select dummy input here",
                choices = names(dummy.list()),
                multiple = FALSE)
  })
  
  
  
  Linear.Regression.Server("dummy", data.tibble = dummy.list()[[input$dummy.input.select]])
  
  
  
  
  
}



shinyApp(ui, server)

回归模块代码

Linear.Regression.UI <- function(id){
  ns <- NS(id)
  tagList(
    actionButton(ns("ClickforRegression"), label = "Click Here to Do Regression"),
    
    uiOutput(ns("Select.Regression.Y.Input")),
    uiOutput(ns("Select.Regression.X.Input")),
    
    verbatimTextOutput(ns("Linear.Model.Output.Summary"))
  )#end of tagList

}#end of Linear.Regression.UI


Linear.Regression.Server <- function(id, data.tibble){
  moduleServer(id, function(input, output, session){
    ns <- session$ns
    
    
    
    output$Select.Regression.Y.Input <- renderUI({
                                            selectInput(inputId = ns("Regression.Y.Input"),
                                            label = "Select Regression Dependent Variable",
                                            choices = names(data.tibble),
                                                       )#end of selectInput for Regression.Y.Input
      
    })#end of renderUI for output$Select.Regression.Y.Input.
    
    
    
    output$Select.Regression.X.Input <- renderUI({
                                            selectInput(inputId = ns("Regression.X.Input"),
                                            label = "Select Regression Independent Variables",
                                             choices= names(data.tibble),
                                             multiple=TRUE
                                                       )#end of selectInput for Regression.X.Input
      
    })#end of renderUI for output$Select.Regression.X.Input.
    
    
    
    
    
    
    
    
    
    
    linear.model <- reactiveVal()  ##linear.model is in the observeEvent handler. Yet, we need to define linear.model in reactiveVal().  Why?
    observeEvent(eventExpr = input$ClickforRegression,
                 linear.model(lm(reformulate(input$Regression.X.Input, input$Regression.Y.Input), data = data.tibble))  # Why put in brackets instead of the assignement operator?
                 )#end of observeEvent
    
    
    output$Linear.Model.Output.Summary <- renderPrint(summary(linear.model()))
    
    
  })#end of moduleServer
  
}

Answer 1

尝试这个

Linear.Regression.UI <- function(id){
  ns <- NS(id)
  tagList(
    actionButton(ns("ClickforRegression"), label = "Click Here to Do Regression"),
    
    uiOutput(ns("Select.Regression.Y.Input")),
    uiOutput(ns("Select.Regression.X.Input")),
    
    verbatimTextOutput(ns("Linear.Model.Output.Summary"))
  )#end of tagList
  
}#end of Linear.Regression.UI

Linear.Regression.Server <- function(id, data.tibble){
  moduleServer(id, function(input, output, session){
    ns <- session$ns
    
    output$Select.Regression.Y.Input <- renderUI({
      selectInput(inputId = ns("Regression.Y.Input"),
                  label = "Select Regression Dependent Variable",
                  choices = names(data.tibble()),
      )#end of selectInput for Regression.Y.Input
      
    })#end of renderUI for output$Select.Regression.Y.Input.
    
    output$Select.Regression.X.Input <- renderUI({
      selectInput(inputId = ns("Regression.X.Input"),
                  label = "Select Regression Independent Variables",
                  choices= names(data.tibble()),
                  multiple=TRUE
      )#end of selectInput for Regression.X.Input
      
    })#end of renderUI for output$Select.Regression.X.Input.

    
    linear.model <- reactiveVal()  ##linear.model is in the observeEvent handler. Yet, we need to define linear.model in reactiveVal().  Why?
    observeEvent(eventExpr = input$ClickforRegression, {
      req(input$Regression.X.Input, input$Regression.Y.Input)
      dfvars <- names(data.tibble())
      myvars <- c(input$Regression.X.Input, input$Regression.Y.Input)
      inds <- which(dfvars %in% myvars)
      
      if (length(dfvars[inds]) > 0 )
                 linear.model(lm(reformulate(input$Regression.X.Input, input$Regression.Y.Input), data = data.tibble()))  # Why put in brackets instead of the assignement operator?
    })#end of observeEvent
    
    
    output$Linear.Model.Output.Summary <- renderPrint(summary(linear.model()))
    
    
  })#end of moduleServer
  
}

# START OF UI ----

ui <- navbarPage(title = "study",
                 inverse=TRUE,
                 
                 tabPanel("Data Inputs",
                          
                          tabPanel("Regression",
                                   uiOutput("dummy.input"),
                                   Linear.Regression.UI("dummy")
                          )#end of tabsPanel Regressions
                 )#end of tabPanel Data Inputs
                 
)#end of navbarPage

# START OF SERVER -----

server <- function(input, output, session, data.tibble){
  
  
  dummy.list <- reactive(list(iris= iris, mtcars = mtcars))
  
  output$dummy.input <- renderUI({
    selectInput(inputId = "dummy.input.select",
                label = "Select dummy input here",
                choices = names(dummy.list()),
                multiple = FALSE)
  })
  
  observe({
    req(input$dummy.input.select)
    Linear.Regression.Server("dummy", data.tibble = reactive({dummy.list()[[input$dummy.input.select]]}))
  })
  
}

shinyApp(ui, server)