r - 使用来自不同模块的输入以 Shiny 的方式对数据进行子集化

Question

我对编码还是很陌生，但想了解模块。我正在尝试构建一个应用程序，该应用程序将根据选定的日期范围显示数据。我尝试使用不同的模块来选择日期和其他模块来处理数据并最终创建图表。目标是在应用程序的不同部分重用其中一些模块。我好像被这篇文章卡住了here .我意识到这篇文章描述了使用模块的callModule方法。

这是应用程序和模块的示例:

library(shiny)

source("test_modules.R")

ui <- fluidPage(
  dateSelectUI("demoDate"),
  
  demoSummaryUI("Demo")
)

server <- function(input, output, session){
  
  demo_date <- dateSelectServer("demoDate")
  
  demoSummaryServer("Demo",
                    dataset = test_app,
                    date_range = demo_date)
  
  
}
shinyApp(ui, server)

dateSelectUI <- function(id){
  
  tagList(dateRangeInput(NS(id, "dateRange"), "Dates", 
                         start = min(ymd(arise_app$year_m)),
                         end = max(ymd(arise_app$year_m)),
                         format = "dd-mm-yyyy")
  )
  
}

dateSelectServer <- function(id){
  
  moduleServer(id, function(input, output, session){
    
    return(
      list(
        min_date <- reactive({input$dateRange[1]}),
        max_date <- reactive({input$dateRange[2]})
      )
    ) 
    
  })
  
}

demoSummaryUI <- function(id){
  
  tagList(infoBoxOutput(NS(id, "numbers"), width = 6),
          infoBoxOutput(NS(id, "period"), width = 6),
          
          # this was to test that the date selection works
          verbatimTextOutput(NS(id, "verbatim"))
  )
  
}


demoSummaryServer <- function(id, dataset, date_range){
  
  moduleServer(id, function(input, output, session){
    
    output$verbatim <- renderPrint({date_range})
    
    # eventually, the data can be filter by date selected:
    # dataset <- dataset %>%
    #   filter(year_m >= date_range$min_date() & year_m <= date_range$max_date())

  })
  
}

和数据:

dput(test_app)
structure(list(BMI = c(36, 32, 25, 35, 25, 30, 39, 44, 38, 24
), prosthesis = c("SIGMA", "SIGMA", "ATTUNE", "ATTUNE", "ATTUNE", 
"SIGMA", "ATTUNE", "ATTUNE", "SIGMA", "SIGMA"), op_duration = structure(c(59, 
60, 121, 63, 73, 64, 81, 60, 60, 65), class = "difftime", units = "mins"), 
    year_m = structure(c(18262, 18262, 18322, 18262, 18262, 18262, 
    18262, 18262, 18293, 18293), class = "Date")), row.names = c(NA, 
-10L), class = c("tbl_df", "tbl", "data.frame"))

我真的很想知道如何解决这个问题，并感谢任何可以提供帮助的人。

Answer 1

您快完成了，这里是再现性的完整示例(解决了您示例中的一些问题):

library(shiny)
library(lubridate)
library(tibble)
library(dplyr)

test_app <- structure(list(BMI = c(36, 32, 25, 35, 25, 30, 39, 44, 38, 24), 
                           prosthesis = c("SIGMA", "SIGMA", "ATTUNE", "ATTUNE", 
                                          "ATTUNE", "SIGMA", "ATTUNE", "ATTUNE", 
                                          "SIGMA", "SIGMA"), 
                           op_duration = structure(c(59, 60, 121, 63, 73, 
                                                     64, 81, 60, 60, 65), 
                                                   class = "difftime", 
                                                   units = "mins"), 
                           year_m = structure(c(18262, 18262, 18322, 18262, 18262, 
                                                18262, 18262, 18262, 18293, 18293), 
                                              class = "Date")), 
                      row.names = c(NA, -10L), 
                      class = c("tbl_df", "tbl", "data.frame"))

dateSelectUI <- function(id) {
   dateRangeInput(NS(id, "dateRange"), "Dates", 
                  start = min(ymd(test_app$year_m)),
                  end = max(ymd(test_app$year_m)),
                  format = "dd-mm-yyyy")
}

dateSelectServer <- function(id) {
   moduleServer(id, function(input, output, session) {
      list(
         min_date = reactive({input$dateRange[1]}),
         max_date = reactive({input$dateRange[2]})
      ) 
   })
}

demoSummaryUI <- function(id) {
   verbatimTextOutput(NS(id, "verbatim"))
}


demoSummaryServer <- function(id, dataset, date_range) {
   moduleServer(id, function(input, output, session){
      output$verbatim <- renderPrint({
         dataset %>%
            filter(year_m >= date_range$min_date() & 
                   year_m <= date_range$max_date())
      })
   })
}

ui <- fluidPage(
   dateSelectUI("demoDate"),
   demoSummaryUI("Demo")
)

server <- function(input, output, session) {
   demo_date <- dateSelectServer("demoDate")
   demoSummaryServer("Demo",
                     dataset = test_app,
                     date_range = demo_date)
}
shinyApp(ui, server)

我认为您的主要问题是您通过 <- 分配了列表元素而不是通过 = .修复后，您的模块将返回 react 列表。要获得 react 的值(value)，您必须“调用”它，正如您在注释代码中所做的那样:date_range$min_date() .