我下面有一个简化的R Shiny应用程序。在菜单项1中有两个菜单项和两个选项卡。
选项卡2有一个DT输出,它是由在React表达式中呈现的数据构建的。
**当前行为:**每次选择menu1和Tab 2时,Tab 2的数据都通过processed_data
React表达式呈现。
期望的行为我希望选项卡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)
字符串
1条答案
按热度按时间pxq42qpu1#
尝试
eventReactive()
,如下所示:字符串