R仅当选择Tab并且更改dateRangeInput时才加载Shiny Render数据

pdtvr36n  于 5个月前  发布在  其他
关注(0)|答案(1)|浏览(33)

我下面有一个简化的R Shiny应用程序。在菜单项1中有两个菜单项和两个选项卡。
选项卡2有一个DT输出,它是由在React表达式中呈现的数据构建的。

**当前行为:**每次选择menu1和Tab 2时,Tab 2的数据都通过processed_dataReact表达式呈现。
期望的行为我希望选项卡2的数据在menu1和选项卡1被选中时自动呈现,但不再次呈现,除非除了这两个条件之外,还有一个条件,即date_range2从其当前值更新(即如果用户离开选项卡2,那么他们可以返回选项卡而不重新呈现数据,除非他们决定更改日期范围)。

我还没有找到一种方法来实现这一点。渲染过程对我的实际数据来说是计算开销很大的,所以我在应用程序中放置了一个操作按钮,要求用户单击操作按钮来渲染数据。然而,因为我默认情况下将数据限制为数据的一个小子集,所以当他们最初进入选项卡时,它会快速加载,因此,我希望它能自动呈现,而不是需要一个按钮点击。
应用代码如下:

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(lubridate)
library(DT)
library(dplyr)

generate_dates <- function(start_date, end_date) {
  all_dates <- seq(start_date, end_date, by = "days")
  all_mondays <- all_dates[weekdays(all_dates) == "Monday"]
  return(all_mondays)
}

start_date <- floor_date(as.Date("2023-07-01"), unit = "week", week_start = 1)
end_date <- floor_date(as.Date("2023-12-06"), unit = "week", week_start = 1)
dates <- generate_dates(start_date, end_date)

df <- data.frame(
  Week = dates,
  Value_1 = sample(c("A", "B", "C", "D"), length(dates), replace = TRUE),
  Value_2 = sample(c("X", "Y", "Z", "W"), length(dates), replace = TRUE)
)

sidebar <- dashboardSidebar(
  sidebarMenu(
    id= "sidebarID",
    conditionalPanel(
      condition="input.sidebarID =='menu1' & input.innerTab=='Tab 1'",
      dateRangeInput("date_range1","Select Tab 1 Date Range",
                     start=max(df$Week),
                     end=max(df$Week),
                     min=max(df$Week),
                     max=max(df$Week),
                     format="yyyy-mm-dd"
                     )
    ),
    conditionalPanel(
      condition="input.sidebarID =='menu1' & input.innerTab=='Tab 2'",
      dateRangeInput("date_range2","Select Tab 2 Date Range",
                     start=max(df$Week),
                     end=max(df$Week),
                     min=max(df$Week),
                     max=max(df$Week),
                     format="yyyy-mm-dd"
      )
    ),
    menuItem("Menu Item 1",tabName="menu1"),
    menuItem("Menu Item 2",tabName="menu2")
  )
)

body<- dashboardBody(
  tabItems(
    tabItem(tabName="menu1",
            tabsetPanel(
              id="innerTab",
              tabPanel("Tab 1"),
              tabPanel("Tab 2",
                       DTOutput("myDataTable")
                       )
            )),
    tabItem(tabName="menu2")
  )
)

ui<-dashboardPage(
  dashboardHeader(title="Navigation"),
  sidebar,
  body
)

server<-function(input,output,session){
  
  processed_data <- reactive({
    shiny::req(input$sidebarID =='menu1' & input$innerTab=='Tab 2')
    
    df%>%
      filter(
      Value_1=="A"
    )
  })
  
  
  output$myDataTable <- renderDT({
    datatable(processed_data())
  })
}
  
  

shinyApp(ui,server)

字符串

pxq42qpu

pxq42qpu1#

尝试eventReactive(),如下所示:

processed_data <- eventReactive(input$date_range2, {
    shiny::req(input$sidebarID =='menu1' & input$innerTab=='Tab 2')
    Sys.sleep(3)  ### delay for calculations
    df%>%
      filter(
        Value_1=="A"
      )
  })

字符串

相关问题