r 闪亮的交互式数据框传递给模块

r shiny interactive data frame pass to module

需要帮助!

当更改 selectInput 时,模块中的 table 没有按预期更改(非反应性)。

有 PROJ_RESULTS_04_202203, PROJ_RESULTS_04_202203,... table 需要根据 selectInput 值进行交互读取,需要使用 shiny 模块显示 table。

代码没有错误。它运行完美。当更改 selectInput 值时 table 在应用程序中更改但在模块中没有更改。

有什么可能的原因吗?

library(shiny)

# Save data  tables ----
df1 <- data.frame(team=c('A', 'A', 'A', 'A', 'A', 'A', 'A', 'A'),
                 points=c(6, 14, 15, 19, 22, 25, 39, 34))

df2 <- data.frame(team=c('B', 'B', 'B', 'B', 'B', 'B','B', 'B'),
                 points=c(1, 2, 3, 4, 5, 6, 7, 8))

saveRDS(df1,"PROJ_RESULTS_04_202203")
saveRDS(df2,"PROJ_RESULTS_04_202204")

# Module UI -----
data_show_UI <- function(id) {
  ns <- NS(id)
  tagList(dataTableOutput(ns("table01")))
}

# Module Server -----
data_show_Server <- function(id, df){
  moduleServer(id,
               function(input, output, session) {
                 ns <- NS(id)

                 output$table01 <-
                   renderDataTable(df)
               })
}
#  UI -----

ui <- fluidPage(titlePanel("dynamic data input"),


                  fluidRow(
                                wellPanel(
                                  # Select year and month
                                  selectInput(
                                    inputId = "selectInput_01",
                                    label = "Year Month",
                                    choices = unique(c(202203, 202204)),
                                    selected = 202203,
                                    selectize = TRUE
                                  )
                                )),

                fluidRow(
                                hr("module"),
                                 data_show_UI("a")
                ),

                fluidRow(
                                hr("not module"),
                                dataTableOutput("table_01")
                                )


)

#  server -----
server <- function(input, output, session) {

  PROJ_RESULTS_04 <- reactive({
    x <- paste0("PROJ_RESULTS_04_", input$selectInput_01)
    return(readRDS(x))

  })


output$table_01 <-
  renderDataTable(PROJ_RESULTS_04())


data_show_Server("a",df = PROJ_RESULTS_04())



}

shinyApp(ui, server)


编辑:

我在更改 data_show_Server 模块时遇到了另一个问题。

我想在渲染之前编辑 df,如下所示,

# Module Server -----
data_show_Server <- function(id, df){
  moduleServer(id,
               function(input, output, session) {
                 ns <- NS(id)

newdf <- reactive({head(df())})
                 output$table01 <-
                   renderDataTable(newdf)
               })
}

现在模块不显示数据table。问题可能出在 newdf <- reactive({head(df())})

这可能是一个小错误,但由于我是 R 编程的新手,我找不到解决它的方法。

后来通过将 newdf 更改为 newdf()

使其工作
data_show_Server <- function(id, df){ moduleServer(id, function(input, output, session) { ns <- NS(id) newdf <- reactive({head(df())}) output$table01 <- renderDataTable(newdf()) }) } ```

为了达到你想要的结果,将 reactive 本身传递给模块服务器,即不使用 () 而是在模块服务器中使用带括号的 df()

library(shiny)

# Module UI -----
data_show_UI <- function(id) {
  ns <- NS(id)
  tagList(dataTableOutput(ns("table01")))
}

# Module Server -----
data_show_Server <- function(id, df) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- NS(id)
      output$table01 <-
        renderDataTable(df())
    }
  )
}
#  UI -----

ui <- fluidPage(
  titlePanel("dynamic data input"),
  fluidRow(
    wellPanel(
      # Select year and month
      selectInput(
        inputId = "selectInput_01",
        label = "Year Month",
        choices = unique(c(202203, 202204)),
        selected = 202203,
        selectize = TRUE
      )
    )
  ),
  fluidRow(
    hr("module"),
    data_show_UI("a")
  ),
  fluidRow(
    hr("not module"),
    dataTableOutput("table_01")
  )
)

#  server -----
server <- function(input, output, session) {
  PROJ_RESULTS_04 <- reactive({
    x <- paste0("PROJ_RESULTS_04_", input$selectInput_01)
    return(readRDS(x))
  })
  data_show_Server("a", df = PROJ_RESULTS_04)
}

shinyApp(ui, server)

从图像中可以看出,这样做之后,数据 table 在选择 202204 时得到更新并显示您的 df2 数据集: