将多个 subMenuItem 链接到同一个 tabItem 并更新 tabBox？
Posted
技术标签:
【中文标题】将多个 subMenuItem 链接到同一个 tabItem 并更新 tabBox？【英文标题】：Linking more than one subMenuItem to the same tabItem and updating tabBox? 【发布时间】：2021-11-22 18:21:00 【问题描述】：我正在开发一个闪亮的仪表板应用程序，并尝试（参见下面的 reprex）将三个不同的 menuSubItems 指向同一个选项卡，同时更新该选项卡上与用户单击的 menuSubItem 相对应的 tabBox。
理由：我正在实现这一点，以便用户可以根据光标所在的位置更轻松地导航到子页面，即在侧边栏上或页面上。
当前状态：正如您在下面的代码中看到的，我已经完成了 85% 的工作，感谢 to this helpful response 使用 javascript (tabs_js)。我编写的脚本将单击选项卡的<a> 中的实际文本分配给 input$activeTab，然后使用随 input$activeTab 状态变化而变化的 observeEvent 更新选定的 tabBox 面板。
问题：由于所有三个 menuSubItems 中的“tabName”都是相同的，因此单击其中任何一个只会显示在侧边栏中单击的第一个（即 aria-selected = true 仅适用于元素 1）。有没有办法保留这种多对一的子菜单方法并将相关子菜单显示为单击？总的来说，有没有更优雅的方法来解决这个问题？
可重现的例子：
library(shiny)
library(shinydashboard)
library(shinyjs)
tabs_js <- '
$(document).ready(function()
$("a[data-toggle=tab").click(function()
var el = $(this).text().trim();
Shiny.setInputValue("activeTab", el);
);
)
'
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id = "side_id",
menuItem("Boxes", tabName = "boxes", selected = T),
menuItem("Foxes", tabName = "foxes",
menuSubItem("Loxes", tabName = "loxes"),
menuSubItem("Roxes", tabName = "loxes"),
menuSubItem("Noxes", tabName = "loxes")
),
verbatimTextOutput("selected_tab_text")
)),
dashboardBody(
useShinyjs(),
tags$head(
tags$script(html(tabs_js))
),
tabItems(
tabItem(tabName = "boxes",
tabBox(
tabPanel("One")
)),
tabItem(tabName = "foxes"),
tabItem(tabName = "loxes",
tabBox(id = "lox_box",
tabPanel("A"),
tabPanel("B"),
tabPanel("C")
)
)
)
)
)
server <- function(session, input, output)
observeEvent(input$activeTab,
if(input$activeTab == "Loxes")
updateTabItems(session, "lox_box", "A")
else if(input$activeTab == "Roxes")
updateTabItems(session, "lox_box", "B")
else if(input$activeTab == "Noxes")
updateTabItems(session, "lox_box", "C")
)
output$selected_tab_text <- renderPrint(
input$activeTab
)
shinyApp(ui = ui, server = server)
编辑：
我发现如果侧边栏的任何元素通过 renderMenu 呈现，javascript 功能就会崩溃（请参阅下面的新表示）。那么如何通过JS访问侧边栏菜单中当前的ul/li元素呢？
library(shiny)
library(shinydashboard)
library(shinyjs)
tabs_js <- '
$(document).ready(function()
$("a[data-toggle=tab]").click(function()
var el = $(this).text().trim();
Shiny.setInputValue("activeTab", el);
);
)
'
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id = "side_id",
menuItem("Boxes", tabName = "boxes", selected = T),
menuItemOutput("fox_menu"),
verbatimTextOutput("selected_tab_text")
)),
dashboardBody(
useShinyjs(),
tags$head(
tags$script(HTML(tabs_js))
),
tabItems(
tabItem(tabName = "boxes",
tabBox(
tabPanel("One", actionButton("tog", "Toggle"))
)),
tabItem(tabName = "foxes"),
tabItem(tabName = "loxes",
tabBox(id = "lox_box",
tabPanel("A"),
tabPanel("B"),
tabPanel("C")
)
)
)
)
)
server <- function(session, input, output)
observeEvent(input$activeTab,
if(input$activeTab == "Loxes")
updateTabItems(session, "lox_box", "A")
else if(input$activeTab == "Roxes")
updateTabItems(session, "lox_box", "B")
else if(input$activeTab == "Noxes")
updateTabItems(session, "lox_box", "C")
)
output$fox_menu <- renderMenu(
menuItem("Foxes", tabName = "foxes",
menuSubItem("Loxes", tabName = "loxes"),
menuSubItem("Roxes", tabName = "loxes"),
menuSubItem("Noxes", tabName = "loxes")
)
)
output$selected_tab_text <- renderPrint(
input$activeTab
)
shinyApp(ui = ui, server = server)
【问题讨论】：
【参考方案1】：看来我回答了我自己的问题（现在是 2/2！）。答案主要是基于JS的。首先，我将 JS 代码更改为如下所示。它找到活动的<a>，获取文本，从任何当前<li> 中删除“活动”类，然后使用户单击的那个类处于活动状态。
jscode <- "
shinyjs.setVal = function()
$('#sidebarCollapsed').find('a[data-toggle=tab]').click(function()
var el = $(this).text().trim();
Shiny.setInputValue('activeTab', el);
var sideb = this;
$('#sidebarCollapsed').find('li.active').removeClass('active');
$(sideb).closest('li').addClass('active');
);
;
"
然后我使用extendShinyjs将它添加到dashboardBody。
dashboardBody(
useShinyjs(),
extendShinyjs(text = jscode, functions = c("setVal"))
最后我创建了一个observeEvent来触发JS函数
observeEvent(input$side_id,
js$setVal()
)
请注意，侧边栏 ID 为“side_id”。这种方法通过查找其名称来触发等于 menuSubItem 的 tabBox 选项卡，并且还使相关的<li> 处于活动状态。出于某种原因，这会破坏我编写的复杂模块化应用程序中的选项卡呈现，但那是另一天的事了。
完整产品：
library(shiny)
library(shinydashboard)
library(shinyjs)
jscode <- "
shinyjs.setVal = function()
$('#sidebarCollapsed').find('a[data-toggle=tab]').click(function()
var el = $(this).text().trim();
Shiny.setInputValue('activeTab', el);
var sideb = this;
$('#sidebarCollapsed').find('li.active').removeClass('active');
$(sideb).closest('li').addClass('active');
);
;
"
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id = "side_id",
menuItem("Boxes", tabName = "boxes", selected = T),
menuItemOutput("fox_menu")
)),
dashboardBody(
useShinyjs(),
extendShinyjs(text = jscode, functions = c("setVal")),
tabItems(
tabItem(tabName = "boxes",
tabBox(
tabPanel("One", actionButton("tog", "Toggle"))
)),
tabItem(tabName = "foxes"),
tabItem(tabName = "loxes",
tabBox(id = "lox_box",
tabPanel("A"),
tabPanel("B"),
tabPanel("C")
)
)
)
)
)
server <- function(session, input, output)
observeEvent(input$activeTab,
if(input$activeTab == "Loxes")
updateTabItems(session, "lox_box", "A")
else if(input$activeTab == "Roxes")
updateTabItems(session, "lox_box", "B")
else if(input$activeTab == "Noxes")
updateTabItems(session, "lox_box", "C")
)
output$fox_menu <- renderMenu(
menuItem("Foxes", tabName = "foxes",
menuSubItem("Loxes", tabName = "loxes"),
menuSubItem("Roxes", tabName = "loxes"),
menuSubItem("Noxes", tabName = "loxes")
)
)
observeEvent(input$side_id,
js$setVal()
)
shinyApp(ui = ui, server = server)
【讨论】：
以上是关于将多个 subMenuItem 链接到同一个 tabItem 并更新 tabBox？的主要内容，如果未能解决你的问题，请参考以下文章
将多个自定义 UITableViewCell 链接到单个 xib