R语言 用于转到下一个和上一个选项卡的通用按钮

vxf3dgd4  于 2023-05-26  发布在  其他
关注(0)|答案(2)|浏览(94)

我知道这是非常接近以前的问题,但经过彻底研究这些例子,我还没有找到一个解决我的特定问题。
我有一个闪亮的应用程序使用闪亮的 Jmeter 板与这种结构(*1)。我可以用这种方式创建下一页或上一页按钮:

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

一个观察者:

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

其中NAME是tabItem ID。这个版本比我发现的使用开关和/或简单地导航到ShinyDashboard中的特定侧边栏菜单项的示例更简单。
但是,这只适用于使用特定按钮从pagename 1切换到pagename 2。
在我的应用程序中有10-20个tabItems:<-我的问题的原因
上面提到的方法需要我写一个actionbutton(next 1,... ac但是下一个2、下一个3等。每个页面1个,每个页面也有一个单独的观察员。
我想说的是:
1个名为“NEXTPAGE”的通用操作按钮,带有一个观察器,用于更新TabItems(会话、选项卡、“当前页面+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(会话,“标签”的东西查询的结果.......)
这样我们就可以做一个更一般的观察者,比如说
如果单击Next[i]按钮,则转到tabItem[i+1]
但就像我说的,我可以想象自己写这样一段代码,只要我知道如何用函数访问tabItems列表(显然我在ui页面中有名字,因为我标记了所有的名字,但我试图通过为每个页面/按钮/观察者输入所有代码来避免所有冗余的重复)
到目前为止我发现的唯一一件事是在观察者中粘贴(input$tabs)会给予你当前的标签,但是然后呢...
谢谢ANY的帮助!
如果不清楚,请随时与我联系

46qrfjad

46qrfjad1#

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

o2rvlv0m2#

正如我在评论中写道:最简单的肯定是重写代码并有一个数组: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?

相关问题