如何在 shinydashboard 中创建让每个选项卡都有自己的日期输入范围的选项
How to create the option of having each tab with its own date input range in shinydashboard
我的 shinydashboard 中有五个选项卡。这五个选项卡中的四个都有自己的表格。这些表格中的每一个都彼此不同并且具有不同的日期范围。我想要一个选项，当用户在其中一个选项卡中输入日期时，它不会影响其他表及其输入范围。但是，对于我下面的代码，情况并非如此。如果我在第一个选项卡中选择一个日期范围，这将影响其他选项卡中显示的日期。下面是我的代码
#ui.R
#----
# Header -----------------------------------------------------------------------|
header<-dashboardHeader( title = "Marketing Dashboard"
)
# Sidebar ----------------------------------------------------------------------|
sidebar<-dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName ="overview", icon = icon("dashboard")),
menuItem("User", tabName ="user", icon = icon("user")),
menuItem("Behavior", tabName ="behavior", icon = icon("people-carry")),
menuItem("Finance", tabName ="finance", icon = icon("piggy-bank")),
menuItem("Weather", tabName ="weather", icon = icon("bolt"))
)
)
# Body -------------------------------------------------------------------------|
body<-dashboardBody(theme = "solar.css",
tabItems(
tabItem(tabName = "overview",
fluidRow(
dateRangeInput("date",
label = 'Date range input',
start = range(tib1$start_time)[2] - 7, end = range(tib1$start_time)[2],
min = range(tib1$start_time)[1], max = range(tib1$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("overviewtable")
)
),
tabItem(tabName = 'user',
fluidRow(
dateRangeInput("date",
label = 'Date range input',
start = range(tib2$end_time)[2] - 7, end = range(tib2$end_time)[2],
min = range(tib2$end_time)[1], max = range(tib2$end_time)[2]
)
),
fluidRow(
DT::dataTableOutput("usertable")
)
),
tabItem(tabName = 'behavior',
fluidRow(
dateRangeInput("date",
label = 'Date range input',
start = range(tib3$start_time)[2] - 7, end = range(tib3$start_time)[2],
min = range(tib3$start_time)[1], max = range(tib3$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("behaviortable")
)
),
tabItem(tabName = 'finance',
fluidRow(
dateRangeInput("date",
label = 'Date range input',
start = range(tib4$start_time)[2] - 7, end = range(tib4$start_time)[2],
min = range(tib4$start_time)[1], max = range(tib4$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("financetable")
)
),
tabItem(tabName = 'weather',
fluidRow(
tags$iframe(
seamless = "seamless",
src = "personal",
height = 800,
width = 1400
)
)
)
)
)
# UI ---------------------------------------------------------------------------|
ui = dashboardPage(
header,
sidebar,
body
)
# server.R
#---------
server <- function(input,output){
#Reactive for dateRangeInput in overview
overviewdata<- reactive({
filter(tib1, between(start_time, input$date[1], input$date[2]))
})
#Table for overview
output$overviewtable<- DT::renderDataTable({
DT::datatable(data =overviewdata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#User Section -----------------------------------------------------------------|
userdata<- reactive({
filter(tib2, between(end_time, input$date[1], input$date[2]))
})
#Table for user
output$usertable<- DT::renderDataTable({
DT::datatable(data =userdata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#Behavior section -------------------------------------------------------------|
behaviordata<- reactive({
filter(tib3, between(start_time, input$date[1], input$date[2]))
})
#Table for overview
output$behaviortable<- DT::renderDataTable({
DT::datatable(data = behaviordata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#Finance section -------------------------------------------------------------|
financedata<- reactive({
filter(tib4, between(start_time, input$date[1], input$date[2]))
})
#Table for overview
output$financetable<- DT::renderDataTable({
DT::datatable(data = financedata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
}
我一直在网上查找并将继续在网上查找答案，但我没有看到任何与此问题完全相关的内容。有没有办法在 dateInputeRange 上放置一个 ID，以便服务器端的 reactive({}) 函数知道 dateinpute 范围来自选项卡 1、2 等
您使用 ns 函数多次调用的 dateRangeInput takes inputId as argument. you can assign different IDs e.g. date_user, date_finance etc. instead of just 'date'. Then you reference each sepcific date_id when filtering in that tab. Alternatively, you can build one module：
#ui.R
#----
# Header -----------------------------------------------------------------------|
header<-dashboardHeader( title = "Marketing Dashboard"
)
# Sidebar ----------------------------------------------------------------------|
sidebar<-dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName ="overview", icon = icon("dashboard")),
menuItem("User", tabName ="user", icon = icon("user")),
menuItem("Behavior", tabName ="behavior", icon = icon("people-carry")),
menuItem("Finance", tabName ="finance", icon = icon("piggy-bank")),
menuItem("Weather", tabName ="weather", icon = icon("bolt"))
)
)
# Body -------------------------------------------------------------------------|
body<-dashboardBody(theme = "solar.css",
tabItems(
tabItem(tabName = "overview",
fluidRow(
dateRangeInput("date_overview",
label = 'Date range input',
start = range(tib1$start_time)[2] - 7, end = range(tib1$start_time)[2],
min = range(tib1$start_time)[1], max = range(tib1$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("overviewtable")
)
),
tabItem(tabName = 'user',
fluidRow(
dateRangeInput("date_user",
label = 'Date range input',
start = range(tib2$end_time)[2] - 7, end = range(tib2$end_time)[2],
min = range(tib2$end_time)[1], max = range(tib2$end_time)[2]
)
),
fluidRow(
DT::dataTableOutput("usertable")
)
),
tabItem(tabName = 'behavior',
fluidRow(
dateRangeInput("date_behaviour",
label = 'Date range input',
start = range(tib3$start_time)[2] - 7, end = range(tib3$start_time)[2],
min = range(tib3$start_time)[1], max = range(tib3$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("behaviortable")
)
),
tabItem(tabName = 'finance',
fluidRow(
dateRangeInput("date_finance",
label = 'Date range input',
start = range(tib4$start_time)[2] - 7, end = range(tib4$start_time)[2],
min = range(tib4$start_time)[1], max = range(tib4$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("financetable")
)
),
tabItem(tabName = 'weather',
fluidRow(
tags$iframe(
seamless = "seamless",
src = "personal",
height = 800,
width = 1400
)
)
)
)
)
# UI ---------------------------------------------------------------------------|
ui = dashboardPage(
header,
sidebar,
body
)
# server.R
#---------
server <- function(input,output){
#Reactive for dateRangeInput in overview
overviewdata<- reactive({
filter(tib1, between(start_time, input$date_overview[1], input$date_overview[2]))
})
#Table for overview
output$overviewtable<- DT::renderDataTable({
DT::datatable(data =overviewdata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#User Section -----------------------------------------------------------------|
userdata<- reactive({
filter(tib2, between(end_time, input$date_user[1], input$date_user[2]))
})
#Table for user
output$usertable<- DT::renderDataTable({
DT::datatable(data =userdata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#Behavior section -------------------------------------------------------------|
behaviordata<- reactive({
filter(tib3, between(start_time, input$date_behaviour[1], input$date_behaviour[2]))
})
#Table for overview
output$behaviortable<- DT::renderDataTable({
DT::datatable(data = behaviordata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#Finance section -------------------------------------------------------------|
financedata<- reactive({
filter(tib4, between(start_time, input$date_finance[1], input$date_finance[2]))
})
#Table for overview
output$financetable<- DT::renderDataTable({
DT::datatable(data = financedata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
}
我的 shinydashboard 中有五个选项卡。这五个选项卡中的四个都有自己的表格。这些表格中的每一个都彼此不同并且具有不同的日期范围。我想要一个选项，当用户在其中一个选项卡中输入日期时，它不会影响其他表及其输入范围。但是，对于我下面的代码，情况并非如此。如果我在第一个选项卡中选择一个日期范围，这将影响其他选项卡中显示的日期。下面是我的代码
#ui.R
#----
# Header -----------------------------------------------------------------------|
header<-dashboardHeader( title = "Marketing Dashboard"
)
# Sidebar ----------------------------------------------------------------------|
sidebar<-dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName ="overview", icon = icon("dashboard")),
menuItem("User", tabName ="user", icon = icon("user")),
menuItem("Behavior", tabName ="behavior", icon = icon("people-carry")),
menuItem("Finance", tabName ="finance", icon = icon("piggy-bank")),
menuItem("Weather", tabName ="weather", icon = icon("bolt"))
)
)
# Body -------------------------------------------------------------------------|
body<-dashboardBody(theme = "solar.css",
tabItems(
tabItem(tabName = "overview",
fluidRow(
dateRangeInput("date",
label = 'Date range input',
start = range(tib1$start_time)[2] - 7, end = range(tib1$start_time)[2],
min = range(tib1$start_time)[1], max = range(tib1$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("overviewtable")
)
),
tabItem(tabName = 'user',
fluidRow(
dateRangeInput("date",
label = 'Date range input',
start = range(tib2$end_time)[2] - 7, end = range(tib2$end_time)[2],
min = range(tib2$end_time)[1], max = range(tib2$end_time)[2]
)
),
fluidRow(
DT::dataTableOutput("usertable")
)
),
tabItem(tabName = 'behavior',
fluidRow(
dateRangeInput("date",
label = 'Date range input',
start = range(tib3$start_time)[2] - 7, end = range(tib3$start_time)[2],
min = range(tib3$start_time)[1], max = range(tib3$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("behaviortable")
)
),
tabItem(tabName = 'finance',
fluidRow(
dateRangeInput("date",
label = 'Date range input',
start = range(tib4$start_time)[2] - 7, end = range(tib4$start_time)[2],
min = range(tib4$start_time)[1], max = range(tib4$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("financetable")
)
),
tabItem(tabName = 'weather',
fluidRow(
tags$iframe(
seamless = "seamless",
src = "personal",
height = 800,
width = 1400
)
)
)
)
)
# UI ---------------------------------------------------------------------------|
ui = dashboardPage(
header,
sidebar,
body
)
# server.R
#---------
server <- function(input,output){
#Reactive for dateRangeInput in overview
overviewdata<- reactive({
filter(tib1, between(start_time, input$date[1], input$date[2]))
})
#Table for overview
output$overviewtable<- DT::renderDataTable({
DT::datatable(data =overviewdata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#User Section -----------------------------------------------------------------|
userdata<- reactive({
filter(tib2, between(end_time, input$date[1], input$date[2]))
})
#Table for user
output$usertable<- DT::renderDataTable({
DT::datatable(data =userdata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#Behavior section -------------------------------------------------------------|
behaviordata<- reactive({
filter(tib3, between(start_time, input$date[1], input$date[2]))
})
#Table for overview
output$behaviortable<- DT::renderDataTable({
DT::datatable(data = behaviordata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#Finance section -------------------------------------------------------------|
financedata<- reactive({
filter(tib4, between(start_time, input$date[1], input$date[2]))
})
#Table for overview
output$financetable<- DT::renderDataTable({
DT::datatable(data = financedata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
}
我一直在网上查找并将继续在网上查找答案，但我没有看到任何与此问题完全相关的内容。有没有办法在 dateInputeRange 上放置一个 ID，以便服务器端的 reactive({}) 函数知道 dateinpute 范围来自选项卡 1、2 等
您使用 ns 函数多次调用的 dateRangeInput takes inputId as argument. you can assign different IDs e.g. date_user, date_finance etc. instead of just 'date'. Then you reference each sepcific date_id when filtering in that tab. Alternatively, you can build one module：
#ui.R
#----
# Header -----------------------------------------------------------------------|
header<-dashboardHeader( title = "Marketing Dashboard"
)
# Sidebar ----------------------------------------------------------------------|
sidebar<-dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName ="overview", icon = icon("dashboard")),
menuItem("User", tabName ="user", icon = icon("user")),
menuItem("Behavior", tabName ="behavior", icon = icon("people-carry")),
menuItem("Finance", tabName ="finance", icon = icon("piggy-bank")),
menuItem("Weather", tabName ="weather", icon = icon("bolt"))
)
)
# Body -------------------------------------------------------------------------|
body<-dashboardBody(theme = "solar.css",
tabItems(
tabItem(tabName = "overview",
fluidRow(
dateRangeInput("date_overview",
label = 'Date range input',
start = range(tib1$start_time)[2] - 7, end = range(tib1$start_time)[2],
min = range(tib1$start_time)[1], max = range(tib1$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("overviewtable")
)
),
tabItem(tabName = 'user',
fluidRow(
dateRangeInput("date_user",
label = 'Date range input',
start = range(tib2$end_time)[2] - 7, end = range(tib2$end_time)[2],
min = range(tib2$end_time)[1], max = range(tib2$end_time)[2]
)
),
fluidRow(
DT::dataTableOutput("usertable")
)
),
tabItem(tabName = 'behavior',
fluidRow(
dateRangeInput("date_behaviour",
label = 'Date range input',
start = range(tib3$start_time)[2] - 7, end = range(tib3$start_time)[2],
min = range(tib3$start_time)[1], max = range(tib3$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("behaviortable")
)
),
tabItem(tabName = 'finance',
fluidRow(
dateRangeInput("date_finance",
label = 'Date range input',
start = range(tib4$start_time)[2] - 7, end = range(tib4$start_time)[2],
min = range(tib4$start_time)[1], max = range(tib4$start_time)[2]
)
),
fluidRow(
DT::dataTableOutput("financetable")
)
),
tabItem(tabName = 'weather',
fluidRow(
tags$iframe(
seamless = "seamless",
src = "personal",
height = 800,
width = 1400
)
)
)
)
)
# UI ---------------------------------------------------------------------------|
ui = dashboardPage(
header,
sidebar,
body
)
# server.R
#---------
server <- function(input,output){
#Reactive for dateRangeInput in overview
overviewdata<- reactive({
filter(tib1, between(start_time, input$date_overview[1], input$date_overview[2]))
})
#Table for overview
output$overviewtable<- DT::renderDataTable({
DT::datatable(data =overviewdata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#User Section -----------------------------------------------------------------|
userdata<- reactive({
filter(tib2, between(end_time, input$date_user[1], input$date_user[2]))
})
#Table for user
output$usertable<- DT::renderDataTable({
DT::datatable(data =userdata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#Behavior section -------------------------------------------------------------|
behaviordata<- reactive({
filter(tib3, between(start_time, input$date_behaviour[1], input$date_behaviour[2]))
})
#Table for overview
output$behaviortable<- DT::renderDataTable({
DT::datatable(data = behaviordata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
#Finance section -------------------------------------------------------------|
financedata<- reactive({
filter(tib4, between(start_time, input$date_finance[1], input$date_finance[2]))
})
#Table for overview
output$financetable<- DT::renderDataTable({
DT::datatable(data = financedata(),
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv","excel","pdf"),
text ="Download"
))#End of button customization
))
})
}