用于转到下一个和上一个 tabItem Shiny 的通用按钮
Generic button for go to next and previous tabItem Shiny
我知道这与之前提出的问题非常接近，但在对这些示例进行深入研究之后，我还没有找到针对我的特定问题的解决方案。
我有一个闪亮的应用程序，它使用具有这种结构的闪亮仪表板 (*1)。我可以这样制作下一页或上一页按钮：
next_btn <- actionButton( inputId ="Next1",
label = icon("arrow-right"))
观察员：
observeEvent(input$Next1, {
updateTabItems(session, "tabs", "NAME")
})
其中 NAME 是标签项 ID。这个版本比我发现使用 switch 和或简单地使用
的示例更简单
但是，这仅适用于使用特定按钮从 pagename1 切换到 pagename2。
但是，我的应用程序中有 10-20 个选项卡项目：** <<- 我的问题的原因**
提到的方法会要求ui让我为每个页面写一个 actionbutton(next1, ... ac but next 2 , next 3 etc. 1 ，并且每个页面都有一个单独的观察者。
我想做的是：
1 个名为 "NEXTPAGE" 的通用操作按钮
与执行 updateTabItems(session, tabs, "current page +1"
的观察者
以我迷路的任何方式转到当前页面+1。我可以想象制作一个包含所有选项卡名称的列表参数，在该列表中找到当前选项卡名称，抓住它的位置，向上（上一个）或向下（下一个）移动一个位置。
但是，除了一些非常费力的手动输入字符串列表之外，我不知道如何获取我的应用程序中存在的所有 tabItems 的列表变量。
*1 应用程序结构：
library(shiny)
library(shinydashboard)
### create general button here like:
### write a function that looks at what (nth) tabItem we are, and creates a ### uiOutput for a next_n button (I can do this myself I think)
dashboardHeader(title = "FLOW C.A.R.S."),
dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem("Home", tabName = "Home", icon = icon("home")),
menuItem("My Page", tabName = "MyPage", icon =icon("download")),
menuItem("Do math", tabName = "Math", icon=icon("folder-open")),
menuItem("Results of something", tabName="Results", icon=
icon("file-text-o")),
menuItem("Short Manual", tabName = "Manual", icon = icon("book"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "Home", class = 'rightAlign',
actionButton( inputId ="Next1", label = icon("arrow-right"))),
tabItem(tabName = "MyPage", class = 'rightAlign',
actionButton( inputId ="Next2", label = icon("arrow-right")),
actionButton( inputId ="Previous2", label = icon("arrow-left"))),
tabItem(tabName = "Math", class = 'rightAlign',
actionButton( inputId ="Next3", label = icon("arrow-right")),
actionButton( inputId ="Previous3", label = icon("arrow-left"))),
tabItem(tabName = "tabName", class = 'rightAlign',
actionButton( inputId ="Next4", label = icon("arrow-right")),
actionButton( inputId ="Previous4", label = icon("arrow-left"))),
tabItem(tabName = "Maual", class = 'rightAlign',
actionButton( inputId ="Previous5", label = icon("arrow-left")))
))
server:
shinyServer = function(input, output, session) {
observeEvent(input$Next1, {
updateTabItems(session, "tabs", "MyPage)
})
observeEvent(input$Previous2, {
updateTabItems(session, "tabs", "Home")
})
observeEvent(input$Next2, {
updateTabItems(session, "tabs", "Math)
})
### repeat for next2 and previous 2 , 3 etc
}
总结，我正在寻找一个代码，它可以为我们提供当前选项卡之前或之后的选项卡的名称，以便我们可以将该查询的结果填充到 updateTabItems(session, "tabs" .......)
这样我们就可以做一个更一般的观察者，例如；
如果单击 Next[i] 按钮转到 tabItem[i+1]
但正如我所说，我可以想象自己编写这样的代码，只要我知道如何使用函数访问 tabItems 列表（显然我在 ui 页面中有名称，因为我标记了所有这些，但我试图通过为每个 page/button/observer)
全部输入来避免所有重复的代码
到目前为止我唯一发现的是观察者内部的 paste(input$tabs) 会给你当前的选项卡，但是然后...
感谢您的帮助！
如有不明之处欢迎随时与我联系
我承认这不是完全概括的。它要求您在服务器中放置一个矢量，该矢量具有 UI 中的选项卡名称。但是，您实际上只需要两个按钮即可使其工作（不是每个选项卡两个按钮）。您只需确保 tab_id 向量具有与 UI 相同顺序的正确名称。如果它是一个小规模的项目，标签和标签名称没有太大变化，你可能可以摆脱这样的事情。
library(shiny)
library(shinydashboard)
library(shinyjs)
### create general button here like:
### write a function that looks at what (nth) tabItem we are, and creates a ### uiOutput for a next_n button (I can do this myself I think)
shinyApp(
ui =
dashboardPage(
dashboardHeader(title = "FLOW C.A.R.S."),
dashboardSidebar(
useShinyjs(),
sidebarMenu(id = "tabs",
menuItem("Home", tabName = "Home", icon = icon("home")),
menuItem("My Page", tabName = "MyPage", icon =icon("download")),
menuItem("Do math", tabName = "Math", icon=icon("folder-open")),
menuItem("Results of something", tabName="Results", icon=
icon("file-text-o")),
menuItem("Short Manual", tabName = "Manual", icon = icon("book"))
)
),
dashboardBody(
hidden(actionButton(inputId ="Previous", label = icon("arrow-left"))),
hidden(actionButton(inputId ="Next", label = icon("arrow-right")))
)
),
server =
shinyServer(function(input, output, session){
tab_id <- c("MyPage", "Math", "Results", "Manual")
observe({
lapply(c("Next", "Previous"),
toggle,
condition = input[["tabs"]] != "Home")
})
Current <- reactiveValues(
Tab = "Home"
)
observeEvent(
input[["tabs"]],
{
Current$Tab <- input[["tabs"]]
}
)
observeEvent(
input[["Previous"]],
{
tab_id_position <- match(Current$Tab, tab_id) - 1
if (tab_id_position == 0) tab_id_position <- length(tab_id)
Current$Tab <- tab_id[tab_id_position]
updateTabItems(session, "tabs", tab_id[tab_id_position])
}
)
observeEvent(
input[["Next"]],
{
tab_id_position <- match(Current$Tab, tab_id) + 1
if (tab_id_position > length(tab_id)) tab_id_position <- 1
Current$Tab <- tab_id[tab_id_position]
updateTabItems(session, "tabs", tab_id[tab_id_position])
}
)
})
)
正如我在评论中所写：
最简单的肯定是重写代码并拥有一个数组：tabItemNames = c("Home", "MyPage",....) 然后相应地命名选项卡 tabItem(tabName = tabItemNames[1],...)、tabItem(tabName = tabItemNames[2],... 等。我不会调用代码的冗余复制，.. .（另见本杰明的回答。
但是，我很欣赏 JS 的挑战并尝试了一下：
您可以使用 JS 来读取 tabItemNames。这将满足不必在代码中对它们进行硬编码的额外要求。
observe({
runjs("
function getAllElementsWithAttribute(attribute){
var matchingElements = [];
var allElements = document.getElementsByTagName('*');
for (var i = 0, n = allElements.length; i < n; i++){
if (allElements[i].getAttribute(attribute) !== null){
matchingElements.push(allElements[i]);
}
}
return matchingElements;
};
ahref = getAllElementsWithAttribute('data-toggle');
var tabNames = [];
var tabName = '';
for (var nr = 0, n = ahref.length; nr < n; nr++){
tabName = ahref[nr].hash.split('-')[2]
if(tabName != 'Toggle navigation') tabNames.push(tabName)
}
Shiny.onInputChange('tabNames', tabNames);
")
})
我假设您没有任何其他具有 'data-toggle' 属性的元素。如果不能满足这一点，则必须在代码中集成更多条件。
在下面的运行例子中，通过上面的代码结合Benjamin提供的代码构建：
library(shiny)
library(shinydashboard)
library(shinyjs)
app <- shinyApp(
ui =
dashboardPage(
dashboardHeader(title = "FLOW C.A.R.S."),
dashboardSidebar(
useShinyjs(),
sidebarMenu(id = "tabs",
menuItem("Home", tabName = "Home", icon = icon("home")),
menuItem("My Page", tabName = "MyPage", icon =icon("download")),
menuItem("Do math", tabName = "Math", icon=icon("folder-open")),
menuItem("Results of something", tabName="Results", icon=
icon("file-text-o")),
menuItem("Short Manual", tabName = "Manual", icon = icon("book"))
)
),
dashboardBody(
actionButton(inputId ="Previous", label = icon("arrow-left")),
actionButton(inputId ="Next", label = icon("arrow-right"))
)
),
server =
shinyServer(function(input, output, session){
global <- reactiveValues(tab_id = "")
tab_id <- c("Home", "MyPage", "Math", "Results", "Manual")
Current <- reactiveValues(
Tab = "Home"
)
observeEvent(
input[["tabs"]],
{
Current$Tab <- input[["tabs"]]
}
)
observeEvent(
input[["Previous"]],
{
tab_id_position <- match(Current$Tab, input$tabNames) - 1
if (tab_id_position == 0) tab_id_position <- length(input$tabNames)
Current$Tab <- input$tabNames[tab_id_position]
updateTabItems(session, "tabs", input$tabNames[tab_id_position])
}
)
observeEvent(
input[["Next"]],
{
tab_id_position <- match(Current$Tab, input$tabNames) + 1
if (tab_id_position > length(input$tabNames)) tab_id_position <- 1
Current$Tab <- input$tabNames[tab_id_position]
updateTabItems(session, "tabs", input$tabNames[tab_id_position])
}
)
observe({
runjs("
function getAllElementsWithAttribute(attribute){
var matchingElements = [];
var allElements = document.getElementsByTagName('*');
for (var i = 0, n = allElements.length; i < n; i++){
if (allElements[i].getAttribute(attribute) !== null){
matchingElements.push(allElements[i]);
}
}
return matchingElements;
};
ahref = getAllElementsWithAttribute('data-toggle');
var tabNames = [];
var tabName = '';
for (var nr = 0, n = ahref.length; nr < n; nr++){
tabName = ahref[nr].hash.split('-')[2]
if(tabName != 'Toggle navigation') tabNames.push(tabName)
}
Shiny.onInputChange('tabNames', tabNames);
")
})
})
)
runApp(app, launch.browser = TRUE)
javascript 函数读取我从这里使用的元素：Get elements by attribute when querySelectorAll is not available without using libraries?
我知道这与之前提出的问题非常接近，但在对这些示例进行深入研究之后，我还没有找到针对我的特定问题的解决方案。
我有一个闪亮的应用程序，它使用具有这种结构的闪亮仪表板 (*1)。我可以这样制作下一页或上一页按钮：
next_btn <- actionButton( inputId ="Next1",
label = icon("arrow-right"))
观察员：
observeEvent(input$Next1, {
updateTabItems(session, "tabs", "NAME")
})
其中 NAME 是标签项 ID。这个版本比我发现使用 switch 和或简单地使用
但是，这仅适用于使用特定按钮从 pagename1 切换到 pagename2。
但是，我的应用程序中有 10-20 个选项卡项目：** <<- 我的问题的原因**
提到的方法会要求ui让我为每个页面写一个 actionbutton(next1, ... ac but next 2 , next 3 etc. 1 ，并且每个页面都有一个单独的观察者。
我想做的是：
1 个名为 "NEXTPAGE" 的通用操作按钮 与执行 updateTabItems(session, tabs, "current page +1"
的观察者以我迷路的任何方式转到当前页面+1。我可以想象制作一个包含所有选项卡名称的列表参数，在该列表中找到当前选项卡名称，抓住它的位置，向上（上一个）或向下（下一个）移动一个位置。 但是，除了一些非常费力的手动输入字符串列表之外，我不知道如何获取我的应用程序中存在的所有 tabItems 的列表变量。
*1 应用程序结构：
library(shiny)
library(shinydashboard)
### create general button here like:
### write a function that looks at what (nth) tabItem we are, and creates a ### uiOutput for a next_n button (I can do this myself I think)
dashboardHeader(title = "FLOW C.A.R.S."),
dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem("Home", tabName = "Home", icon = icon("home")),
menuItem("My Page", tabName = "MyPage", icon =icon("download")),
menuItem("Do math", tabName = "Math", icon=icon("folder-open")),
menuItem("Results of something", tabName="Results", icon=
icon("file-text-o")),
menuItem("Short Manual", tabName = "Manual", icon = icon("book"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "Home", class = 'rightAlign',
actionButton( inputId ="Next1", label = icon("arrow-right"))),
tabItem(tabName = "MyPage", class = 'rightAlign',
actionButton( inputId ="Next2", label = icon("arrow-right")),
actionButton( inputId ="Previous2", label = icon("arrow-left"))),
tabItem(tabName = "Math", class = 'rightAlign',
actionButton( inputId ="Next3", label = icon("arrow-right")),
actionButton( inputId ="Previous3", label = icon("arrow-left"))),
tabItem(tabName = "tabName", class = 'rightAlign',
actionButton( inputId ="Next4", label = icon("arrow-right")),
actionButton( inputId ="Previous4", label = icon("arrow-left"))),
tabItem(tabName = "Maual", class = 'rightAlign',
actionButton( inputId ="Previous5", label = icon("arrow-left")))
))
server:
shinyServer = function(input, output, session) {
observeEvent(input$Next1, {
updateTabItems(session, "tabs", "MyPage)
})
observeEvent(input$Previous2, {
updateTabItems(session, "tabs", "Home")
})
observeEvent(input$Next2, {
updateTabItems(session, "tabs", "Math)
})
### repeat for next2 and previous 2 , 3 etc
}
总结，我正在寻找一个代码，它可以为我们提供当前选项卡之前或之后的选项卡的名称，以便我们可以将该查询的结果填充到 updateTabItems(session, "tabs" .......)
这样我们就可以做一个更一般的观察者，例如；
如果单击 Next[i] 按钮转到 tabItem[i+1]
但正如我所说，我可以想象自己编写这样的代码，只要我知道如何使用函数访问 tabItems 列表（显然我在 ui 页面中有名称，因为我标记了所有这些，但我试图通过为每个 page/button/observer)
全部输入来避免所有重复的代码到目前为止我唯一发现的是观察者内部的 paste(input$tabs) 会给你当前的选项卡，但是然后...
感谢您的帮助！
如有不明之处欢迎随时与我联系
我承认这不是完全概括的。它要求您在服务器中放置一个矢量，该矢量具有 UI 中的选项卡名称。但是，您实际上只需要两个按钮即可使其工作（不是每个选项卡两个按钮）。您只需确保 tab_id 向量具有与 UI 相同顺序的正确名称。如果它是一个小规模的项目，标签和标签名称没有太大变化，你可能可以摆脱这样的事情。
library(shiny)
library(shinydashboard)
library(shinyjs)
### create general button here like:
### write a function that looks at what (nth) tabItem we are, and creates a ### uiOutput for a next_n button (I can do this myself I think)
shinyApp(
ui =
dashboardPage(
dashboardHeader(title = "FLOW C.A.R.S."),
dashboardSidebar(
useShinyjs(),
sidebarMenu(id = "tabs",
menuItem("Home", tabName = "Home", icon = icon("home")),
menuItem("My Page", tabName = "MyPage", icon =icon("download")),
menuItem("Do math", tabName = "Math", icon=icon("folder-open")),
menuItem("Results of something", tabName="Results", icon=
icon("file-text-o")),
menuItem("Short Manual", tabName = "Manual", icon = icon("book"))
)
),
dashboardBody(
hidden(actionButton(inputId ="Previous", label = icon("arrow-left"))),
hidden(actionButton(inputId ="Next", label = icon("arrow-right")))
)
),
server =
shinyServer(function(input, output, session){
tab_id <- c("MyPage", "Math", "Results", "Manual")
observe({
lapply(c("Next", "Previous"),
toggle,
condition = input[["tabs"]] != "Home")
})
Current <- reactiveValues(
Tab = "Home"
)
observeEvent(
input[["tabs"]],
{
Current$Tab <- input[["tabs"]]
}
)
observeEvent(
input[["Previous"]],
{
tab_id_position <- match(Current$Tab, tab_id) - 1
if (tab_id_position == 0) tab_id_position <- length(tab_id)
Current$Tab <- tab_id[tab_id_position]
updateTabItems(session, "tabs", tab_id[tab_id_position])
}
)
observeEvent(
input[["Next"]],
{
tab_id_position <- match(Current$Tab, tab_id) + 1
if (tab_id_position > length(tab_id)) tab_id_position <- 1
Current$Tab <- tab_id[tab_id_position]
updateTabItems(session, "tabs", tab_id[tab_id_position])
}
)
})
)
正如我在评论中所写：
最简单的肯定是重写代码并拥有一个数组：tabItemNames = c("Home", "MyPage",....) 然后相应地命名选项卡 tabItem(tabName = tabItemNames[1],...)、tabItem(tabName = tabItemNames[2],... 等。我不会调用代码的冗余复制，.. .（另见本杰明的回答。
但是，我很欣赏 JS 的挑战并尝试了一下： 您可以使用 JS 来读取 tabItemNames。这将满足不必在代码中对它们进行硬编码的额外要求。
observe({
runjs("
function getAllElementsWithAttribute(attribute){
var matchingElements = [];
var allElements = document.getElementsByTagName('*');
for (var i = 0, n = allElements.length; i < n; i++){
if (allElements[i].getAttribute(attribute) !== null){
matchingElements.push(allElements[i]);
}
}
return matchingElements;
};
ahref = getAllElementsWithAttribute('data-toggle');
var tabNames = [];
var tabName = '';
for (var nr = 0, n = ahref.length; nr < n; nr++){
tabName = ahref[nr].hash.split('-')[2]
if(tabName != 'Toggle navigation') tabNames.push(tabName)
}
Shiny.onInputChange('tabNames', tabNames);
")
})
我假设您没有任何其他具有 'data-toggle' 属性的元素。如果不能满足这一点，则必须在代码中集成更多条件。
在下面的运行例子中，通过上面的代码结合Benjamin提供的代码构建：
library(shiny)
library(shinydashboard)
library(shinyjs)
app <- shinyApp(
ui =
dashboardPage(
dashboardHeader(title = "FLOW C.A.R.S."),
dashboardSidebar(
useShinyjs(),
sidebarMenu(id = "tabs",
menuItem("Home", tabName = "Home", icon = icon("home")),
menuItem("My Page", tabName = "MyPage", icon =icon("download")),
menuItem("Do math", tabName = "Math", icon=icon("folder-open")),
menuItem("Results of something", tabName="Results", icon=
icon("file-text-o")),
menuItem("Short Manual", tabName = "Manual", icon = icon("book"))
)
),
dashboardBody(
actionButton(inputId ="Previous", label = icon("arrow-left")),
actionButton(inputId ="Next", label = icon("arrow-right"))
)
),
server =
shinyServer(function(input, output, session){
global <- reactiveValues(tab_id = "")
tab_id <- c("Home", "MyPage", "Math", "Results", "Manual")
Current <- reactiveValues(
Tab = "Home"
)
observeEvent(
input[["tabs"]],
{
Current$Tab <- input[["tabs"]]
}
)
observeEvent(
input[["Previous"]],
{
tab_id_position <- match(Current$Tab, input$tabNames) - 1
if (tab_id_position == 0) tab_id_position <- length(input$tabNames)
Current$Tab <- input$tabNames[tab_id_position]
updateTabItems(session, "tabs", input$tabNames[tab_id_position])
}
)
observeEvent(
input[["Next"]],
{
tab_id_position <- match(Current$Tab, input$tabNames) + 1
if (tab_id_position > length(input$tabNames)) tab_id_position <- 1
Current$Tab <- input$tabNames[tab_id_position]
updateTabItems(session, "tabs", input$tabNames[tab_id_position])
}
)
observe({
runjs("
function getAllElementsWithAttribute(attribute){
var matchingElements = [];
var allElements = document.getElementsByTagName('*');
for (var i = 0, n = allElements.length; i < n; i++){
if (allElements[i].getAttribute(attribute) !== null){
matchingElements.push(allElements[i]);
}
}
return matchingElements;
};
ahref = getAllElementsWithAttribute('data-toggle');
var tabNames = [];
var tabName = '';
for (var nr = 0, n = ahref.length; nr < n; nr++){
tabName = ahref[nr].hash.split('-')[2]
if(tabName != 'Toggle navigation') tabNames.push(tabName)
}
Shiny.onInputChange('tabNames', tabNames);
")
})
})
)
runApp(app, launch.browser = TRUE)
javascript 函数读取我从这里使用的元素：Get elements by attribute when querySelectorAll is not available without using libraries?