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 h
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?
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])
}
)
})
)