使用来自不同模块的输入来对闪亮的数据进行子集化答案

【问题标题】：Using input from different module to subset data in shiny使用来自不同模块的输入来对闪亮的数据进行子集化
【发布时间】：2021-09-13 20:41:21
【问题描述】：

我对编码还是很陌生，但想了解模块。我正在尝试构建一个应用程序，该应用程序将根据选定的日期范围显示数据。我尝试使用不同的模块来选择日期和其他模块来处理数据并最终创建绘图。目标是在应用程序的不同部分重用其中一些模块。在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"))

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

【问题讨论】：

标签： r shiny

【解决方案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)

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

【讨论】：