Question

我知道这与以前讨论的问题非常接近，但在仔细研究这些例子后，我还没有找到解决我特定问题的方法。

我使用具有此结构的闪亮仪表板（* 1）有一个闪亮的应用程序。我可以这样制作下一个或上一个页面按钮：

next_btn        <-    actionButton(   inputId ="Next1", 
                                      label = icon("arrow-right"))

与观察员：

  observeEvent(input$Next1, {
    updateTabItems(session, "tabs", "NAME")
  })

其中NAME是tabItem ID。此版本比我发现使用开关和/或只是Navigate to particular sidebar menu item in ShinyDashboard?

的示例更简单

但是，这仅适用于使用特定按钮从pagename1切换到pagename2。

然而，我的应用程序中有10-20个tabItem：**＆lt;＆lt; - 我的问题的原因**

提到的方法需要我写一个动作按钮（next1，... ac但是接下来的2，接下来的3等等，每个页面，还有一个单独的观察者。

我想要做的是：

1个通用操作按钮，名为＆＃34; NEXTPAGE＆＃34; 与观察者一起做updateTabItems（会话，标签，＆＃34;当前页+ 1＆＃34;

以我丢失的任何方式转到当前页面+1。我可以想象制作所有标签名称的列表参数，找到该列表中的当前标签名称，抓住它的位置，例如向上移动一个位置（向前移动）或向下移动（接下来）。但是，我不知道如何获取我的应用程序中存在的所有tabItem的列表变量，除了一些非常费力的手动键入字符串列表。

* 1 app结构：

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 

}

总结，我正在寻找一个代码，它会在当前选项卡之前提供Tab之后的名称，以便我们可以将该查询的结果填充到updateTabItems（session，＆＃34;标签＆＃34; .......）

这样我们就可以建立一个比较普通的观察者;

如果单击Next [i]按钮，请转到tabItem [i + 1]

但就像我说的那样，我可以想象自己编写这样的代码，只要我知道如何使用函数访问tabItems列表（显然我在ui页面中有名字，因为我标记了所有这些，但我和＃39; m试图通过为每个页面/按钮/观察者输入全部来避免所有重复的代码重复）

我发现到目前为止唯一的事情是观察者内部的粘贴（输入$ tabs）将为您提供当前标签，但接着是什么...

感谢您的帮助！

如果不清楚，请随时与我联系

Answer 1

我承认这不是完全概括的。它要求您在服务器中放置一个向量，该向量具有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]) 
        }
      )
    })
)

Answer 2

正如我在评论中写道：最简单的方法是确保重写代码并拥有一个数组：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?

通用按钮转到下一个和上一个tabItem Shiny

2 个答案: