响应式更新模块化 Shiny 应用程序中的侧边栏
Posted
技术标签:
【中文标题】响应式更新模块化 Shiny 应用程序中的侧边栏【英文标题】：Reactively updating sidebar in modular Shiny app 【发布时间】：2021-03-23 12:01:33 【问题描述】：我有一个使用bs4Dash 的模块化Golem 应用程序。我想从renderUI 动态生成的actionBttn 更新活动侧边栏选项卡。虽然updatebs4ControlbarMenu 按预期工作as shown here，但它在应用程序的模块化版本中不起作用。我究竟做错了什么？我怀疑它与跨模块的input[[btnID]] 管理有关，但我很难找到解决方案。
没有模块的工作示例as shown here:
library(shiny)
library(shinyWidgets)
library(bs4Dash)
library(tidyverse)
shinyApp(
ui = bs4DashPage(
sidebar_collapsed = FALSE,
controlbar_collapsed = TRUE,
enable_preloader = FALSE,
navbar = bs4DashNavbar(skin = "dark"),
sidebar = bs4DashSidebar(
inputId = "sidebarState",
bs4SidebarMenu(
id = "sidebr",
bs4SidebarMenuItem(
"Tab 1",
tabName = "tab1"
),
bs4SidebarMenuItem(
"Tab 2",
tabName = "tab2"
)
)
),
bs4DashBody(
bs4TabItems(
bs4TabItem(
tabName = "tab1",
h1("Welcome!"),
fluidRow(
pickerInput(
inputId = "car",
label = "Car",
choices = row.names(mtcars),
selected = head(row.names(mtcars), 3),
multiple = TRUE,
options = list(
`actions-box` = TRUE)
),
pickerInput(
inputId = "gear",
label = "Gear",
choices = unique(mtcars$gear),
selected = unique(mtcars$gear),
multiple = TRUE,
options = list(
`actions-box` = TRUE)
)
),
fluidRow(
column(6,
uiOutput("uiboxes")
)
)
),
bs4TabItem(
tabName = "tab2",
h4("Yuhuuu! You've been directed automatically in Tab 2!")
)
)
)
),
server = function(input, output, session)
submtcars <- reactive(
req(input$car, input$gear)
mtcars %>%
mutate(
carnames = rownames(mtcars)) %>%
filter(
carnames %in% input$car &
gear %in% input$gear
)
)
observeEvent( submtcars(),
n_ex <- nrow(submtcars())
output$uiboxes <- renderUI(
lapply(1:n_ex, FUN = function(j)
print(paste("j is ", j))
bs4Box(
title = submtcars()$carnames[j],
width = 12,
str_c("Number of gears:", submtcars()$gear[j]),
btnID <- paste0("btnID", j),
print(btnID),
fluidRow(
column(
2,
actionBttn(
inputId = btnID,
icon("search-plus")
)
)
)
)
)
)
lapply(1:n_ex, function(j)
btnID <- paste0("btnID", j)
observeEvent(input[[btnID]] ,
updatebs4ControlbarMenu(
session,
inputId = "sidebr",
selected = "tab2"
)
)
)
)
)
模块化尝试不起作用：
library(shiny)
library(shinyWidgets)
library(bs4Dash)
library(tidyverse)
mod_exlib_ui <- function(id)
ns <- NS(id)
tagList(
fluidRow(
pickerInput(
inputId = ns("car"),
label = "Car",
choices = row.names(mtcars),
selected = head(row.names(mtcars), 3),
multiple = TRUE,
options = list(
`actions-box` = TRUE)
),
pickerInput(
inputId = ns("gear"),
label = "Gear",
choices = unique(mtcars$gear),
selected = unique(mtcars$gear),
multiple = TRUE,
options = list(
`actions-box` = TRUE)
)
),
fluidRow(
column(6,
uiOutput(ns("uiboxes"))
)
)
)
mod_exlib_server <- function(id)
moduleServer( id, function(input, output, session)
ns <- session$ns
submtcars <- reactive(
# req(input$car, input$gear)
mtcars %>%
dplyr::mutate(
carnames = rownames(mtcars)) %>%
dplyr::filter(
carnames %in% input$car &
gear %in% input$gear
)
)
observeEvent( submtcars(),
n_ex <- nrow(submtcars())
output$uiboxes <- renderUI(
lapply(1:n_ex, FUN = function(j)
print(paste("j is ", j))
bs4Box(
title = submtcars()$carnames[j],
width = 12,
paste("Number of gears: ", submtcars()$gear[j]),
btnID <- paste0("btnID", j),
print(btnID),
fluidRow(
column(
2,
actionBttn(
inputId = ns(btnID),
icon("search-plus")
)
)
)
)
)
)
lapply(1:n_ex, function(j)
btnID <- paste0("btnID", j)
observeEvent(input[[btnID]] ,
print(btnID)
updatebs4ControlbarMenu(
session,
inputId = "sidebr",
selected = "exdet2"
)
)
)
)
)
app_ui <- tagList(
bs4DashPage(
navbar = bs4DashNavbar(),
sidebar = bs4DashSidebar(
expand_on_hover = TRUE,
inputId = "sidebarState",
bs4SidebarMenu(
id = "sidebr",
bs4SidebarMenuItem(
"Tab 1",
tabName = "tab1"
),
bs4SidebarMenuItem(
"Tab 2",
tabName = "tab2"
)
)
),
bs4DashBody(
bs4TabItems(
bs4TabItem(
tabName = "tab1",
h1("Welcome!"),
mod_exlib_ui("exlib_ui_1")
),
bs4TabItem(
tabName = "tab2",
h4("Yuhuuu! You've been directed automatically in Tab 2!")
)
)
)
)
)
app_server <- function( input, output, session )
# Your application server logic
mod_exlib_server("exlib_ui_1")
shinyApp(
ui = app_ui,
server = app_server)
【问题讨论】：
【参考方案1】：探索了同族函数updatebs4TabSetPanel()的例子后，似乎选择的值需要是一个数字。
因此，您可以将此代码与 CRAN 版本 0.5.0 一起使用：
updatebs4ControlbarMenu(
session,
inputId = "sidebr",
selected = "2" #"exdet2"
)
【讨论】：
它不起作用。在为updatebs4TabSetPanel() 提供的示例中，selected 不是数字，而是一个字符串（即paste("Tab", input$controller2)）：rinterface.github.io/bs4Dash/reference/…
input$controller2 是 slideInput 的输出，它是数字的。我使用 CRAN 上的 0.5.0 版。你用的是哪个版本？
bs4Dash' 版本 0.6.0.9000。但是，我认为问题与模块以及如何处理 id 更相关？相同的应用程序在未模块化时可以正常工作，如下所示：***.com/a/65241808/7375944
v0.6.0 从未发布过。它将直接从 0.5.0 跳到 2.0，其中有许多重大变化。我建议您回到 CRAN 版本或完全更改为 v2。我向您保证，我的代码修改适用于我这边的 0.5.0。如果你想让我测试你的版本，你必须给我你从 github 下载的版本的提交 SHA1。你可以通过packageDescription("bs4Dash")看到它
GithubSHA1: 5dfbc155d8f32f4d5e0f27aee2740da295f2ffe0以上是关于响应式更新模块化 Shiny 应用程序中的侧边栏的主要内容，如果未能解决你的问题，请参考以下文章
如何使用 `renderUI` 响应式更新 Shiny 应用程序中的活动菜单项？