时间戳

首页 > 解决方案 > 使用来自不同模块的输入来对闪亮的数据进行子集化

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

问题描述

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

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

标签： rshiny

解决方案

您快到了，这是可重复性的完整示例（解决您的示例的一些问题）：

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()：

推荐阅读