Generic button for go to next and previous tabItem Shiny - r

Question

I know this is pretty close to previously aked questions, but after thorough study of those examples I haven't found a solution for my particular problemm yet.
I have a shiny App using Shiny Dashboard with this structure (*1). I can make a next or previous page button this way:
next_btn <- actionButton( inputId ="Next1",
label = icon("arrow-right"))
with an observer :
observeEvent(input$Next1, {
updateTabItems(session, "tabs", "NAME")
})
where NAME is the tabItem ID. This version is simpler than the expamples I've found that use switch and or simply Navigate to particular sidebar menu item in ShinyDashboard?
However, this only works to switch from pagename1 to pagename2 with a specific button for it.
I have however, 10-20 tabItems in my app : ** <<- the reason for my problem**
The approach mentioned about would require me to write a actionbutton(next1, ... ac but next 2 , next 3 etc. 1 for each page, and also an separate observer for each.
What I am trying to make is this:
1 generic action button called "NEXTPAGE"
with an observer that does updateTabItems(session, tabs, "current page +1"
to to the current page +1 in whatever way I'm lost. I could imagine making a list parameter of all tab names, find the current tabname in that list, grab it's position, shift one position up (previous), or down (next) for example.
However, I do not know how to get a list variable of all tabItems present in my app, other than some very laborious manual typing of a list of strings.
*1 app structure:
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
}
Summary, I'm looking for a code that will give us the name of the Tab coming after of before the current tab, so that we can stuff the outcome of that query into updateTabItems(session, "tabs" .......)
so that we can make a more general observer that says for instance;
if Next[i] button is clicked go to tabItem[i+1]
but like I said, I can imagine myself writing such a code, if only if I knew how to access the list of tabItems with function (obviously I have the names in the ui page since I labelled all of them, but I'm trying to avoid all the redunant repetition of code by typing it all out for each page/button/observer)
only thing I discoverd so far is that paste(input$tabs) inside an observer will give you the current tab, but then what...
thanks for anny help!
If it's unclear, please feel free to contact me

Answer 1

I will admit that this is not fully generalized. It requires that you place a vector in your server that has the names of the tabs from the UI. But, you really only need two buttons to make it work (not two buttons per tab). You only need to make sure that the tab_id vector has the correct names in the same order as the UI. You can probably get away with something like this if it is a small scale project where the tabs and tab names are not changing a lot.
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

As i wrote in the comment:
The easiest would be for sure to rewrite the code and have an array: tabItemNames = c("Home", "MyPage",....) and then name the tabs accordingly tabItem(tabName = tabItemNames[1],...), tabItem(tabName = tabItemNames[2],... etc. That i wouldnt call redundant repition of code,...(see also Benjamin´s answer.
However, I appreciated the JS challenge and gave it a shot:
You could use JS to read the tabItemNames. That would fulfill the bonus requirement of not having to hardcode them in the code.
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);
")
})
The assumption i make that you do not have any further element having a 'data-toggle' attribute. If this would not be fulfilled one would have to integrate further conditions in the code.
In the following a running example, build by the code above combined with the code provided by 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)
The javascript function to read the elements I used from here: Get elements by attribute when querySelectorAll is not available without using libraries?