scoping issue with updateNavbarPage() function from within shiny module - r

I am trying to build an app where the user is able to switch tabs when clicking on a specific object. However, I have developed the app using modules and would like to continue to do so. I am running into a problem with the scoping when trying to call the updateNavbarPage() function from inside of the modules. I have created a MWE example to illustrate the problem.
#==================================================
# MRE for updateNavBar scoping issue within modules
#==================================================
modOneUI <- function(id){
ns <- NS(id)
tagList(
h4(
"Click this button to change tabs!"
),
actionButton(
ns("submit"),
label = "Go to next Tab"
)
)
}
modOne <- function(input, output, session){
observeEvent(input$submit, {
updateNavbarPage(session, "nav-page", "tab2")
})
}
ui <- shinyUI(
navbarPage(
id = "nav-page",
title = "Example Navbar Page Issue",
tabPanel(
id = "tab1",
value = "tab1",
div(
"Tab 1"
),
div(
modOneUI("tab1_mod")
)
),
tabPanel(
id = "tab2",
value = "tab2",
div(
"Tab 2"
),
div(
h4("This is the second tab")
)
)
)
)
server <- shinyServer(function(input, output, session){
callModule(modOne, "tab1_mod")
})
shinyApp(ui = ui, server = server)
When this app is run, and the action button is clicked on the first tab, nothing happens. However if you remove the module and place the ui and server module code directly into the ui and server portions then clicking the button works. Here is the code with the modules removed.
ui <- shinyUI(
navbarPage(
id = "nav-page",
title = "Example Navbar Page Issue",
tabPanel(
id = "tab1",
value = "tab1",
div(
"Tab 1"
),
div(
h4(
"Click this button to change tabs!"
),
actionButton(
"submit",
label = "Go to next Tab"
)
)
),
tabPanel(
id = "tab2",
value = "tab2",
div(
"Tab 2"
),
div(
h4("This is the second tab")
)
)
)
)
server <- shinyServer(function(input, output, session){
observeEvent(input$submit, {
updateNavbarPage(session, "nav-page", "tab2")
})
})
shinyApp(ui = ui, server = server)
Is there any way to use updateNavbarPage() from within a module to switch to a tab that is in not in the module?

Do not ask me why :-) but it works like this:
modOne <- function(input, output, session, x){
observeEvent(input$submit, {
updateNavbarPage(x, "nav-page", "tab2")
})
}
callModule(modOne, "tab1_mod", x=session)

Related

Shiny: How to hide and show elements based on keypress / key. input

I am trying to build an app in shiny that hide / shows "pages" when a specific key is pressed to simulate an implicit association test. Participants at the beginning get instructed and then (from IAT1 on) have to press either "e" or "i" when a specific word appears and then the next word should be presented. This means that the first word should disappear and the new word appear when "e" or "i" is pressed. As I did not get very far right now after IAT 1 (word 1) not the second word is presented but the welcome page again to test the key input.
Instead of e.keyCode I also tried e.which but the key input seems not to change anything or to let elements appear / disappear and I don't know what I am doing wrong or where the problem might be.
ui <- fluidPage(
useShinyjs(),
div(
id = "welcome",
mainPanel(
fluidRow(
h3("Welcome"),
p("Welcome to the test."),
br(),
actionButton("continue1", label = "weiter")
)
)
),
hidden(
div(
id = "instruction",
mainPanel(
fluidRow(
h3("Instruction"),
p("Please ...")),
br(),
actionButton("continue2", label = "weiter"))
)
),
hidden(
div(
id = "IAT1",
mainPanel(
fluidRow(
h3("IAT"),
p("IAT word 1")),
br(),
tags$script('$(document).on("keypress", function(e) {
shiny.onInputChange("keyid1", e.keyCode);
});'))
))
)
#####server#
useShinyjs()
server <- function(input, output) {
observeEvent(input$continue1, {
show("instruction")
hide("welcome")
})
observeEvent(input$continue2, {
show("IAT1")
hide("instruction")
})
observeEvent(input$keyid1,{
if(e.keyCode == 69) {
hide("IAT1")
show("welcome")
}
else {}
})
}
shinyApp(ui = ui, server = server)
Try this, I added the keys (e,i, SHIFT+e, SHIFT+i)
library(shiny)
library(ggplot2)
ui <- fluidPage(
useShinyjs(),
div(
id = "welcome",
mainPanel(
fluidRow(
h3("Welcome"),
p("Welcome to the test."),
br(),
actionButton("continue1", label = "weiter")
)
)
),
hidden(
div(
id = "instruction",
mainPanel(
fluidRow(
h3("Instruction"),
p("Please ...")),
br(),
actionButton("continue2", label = "weiter"))
)
),
hidden(
div(
id = "IAT1",
mainPanel(
fluidRow(
h3("IAT"),
p("IAT word 1")),
br(),
tags$script('$(document).on("keypress", function(e) {
Shiny.onInputChange("keyid1", e.keyCode);
});'))
))
)
server <- function(input, output,session) {
observeEvent(input$continue1, {
show("instruction")
hide("welcome")
})
observeEvent(input$continue2, {
show("IAT1")
hide("instruction")
})
observeEvent(input$keyid1,{
print(input$keyid1)
if(input$keyid1 %in% c(101,105,69,73)) {
hide("IAT1")
show("welcome")
}
else {}
})
}
shinyApp(ui = ui, server = server)

R shiny collapsible sidebar

I have created the following application template in R shiny :
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage("",actionButton("toggleSidebar", "toggle", icon =
icon("database")),
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),mainPanel() ))))
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}) }
shinyApp(ui, server)
The App will create a toggle button in the sidebar. The button should appear in the navbar and not above the sidebar. The actual toggle button appears above next to the word tab. It is however, not visible.
The part that is not visible that you mention is in fact the empty title parameter that you have "". Leaving this out as below places the toggle button in the title position:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(actionButton("toggleSidebar", "toggle", icon =
icon("database")),
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),mainPanel() )))
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}) }
shinyApp(ui, server)
I made an example with multiple tabPanels.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
id = "navbarID",
tabPanel("tab1",
div(class="sidebar"
,sidebarPanel("sidebar1")
),
mainPanel(
"MainPanel1"
)
),
tabPanel("tab2",
div(class="sidebar"
,sidebarPanel("sidebar2")
),
mainPanel(
"MainPanel2"
)
)
)
)
server <-function(input, output, session) {
observeEvent(input$sidebar_button,{
shinyjs::toggle(selector = ".sidebar")
})
}
shinyApp(ui, server)
=======================================
I have created a simpler example that does not use the sidepanel class, but I am not sure if it will work in all environments.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
tabPanel("tab1",
sidebarPanel("sidebar1"),
mainPanel("MainPanel1")
),
tabPanel("tab2",
sidebarPanel("sidebar2"),
mainPanel("MainPanel2")
)
)
)
server <-function(input, output, session) {
observeEvent(input$sidebar_button,{
shinyjs::toggle(selector = ".tab-pane.active div:has(> [role='complementary'])")
})
}
shinyApp(ui, server)

Call updateTabItems from inside Shiny module

In my shiny app I have lots of valueBoxes, each representing a tabItem in the sidebar of the shinydashboard. When clicking on the valueBox the page should move to the correct tab.
Instead of copypasting the code lots of times I wrote a reusable module which renders the valueBox and changes the class of the valueBox into an actionButton. In the server part I have included an observeEvent which calls updateTabItems when the valueBox is clicked. But when clicked nothing happens. It seems that the module cannot manipulate the dashboard sidebar.
library(shiny)
library(shinydashboard)
value_box_output <- function(.id) {
ns <- NS(.id)
valueBoxOutput(ns("overview.box"))
}
value_box <- function(input, output, session, .value, .subtitle, .tab.name) {
ns <- session$ns
output$overview.box <- renderValueBox({
box1 <- valueBox(
.value,
.subtitle,
href = "#",
width = NULL
)
box1$children[[1]]$attribs$class <- "action-button"
box1$children[[1]]$attribs$id <- ns("button")
box1
})
observeEvent(input$button, {
print("clicked")
updateTabItems(session, inputId = "tabs", selected = .tab.name)
})
}
ui <- dashboardPage(
dashboardHeader(title = "Title"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Overview", tabName = "Overview"),
menuItem("Tab 1", tabName = "Tab_1")
)
),
dashboardBody(
tabItems(
tabItem("Overview", value_box_output("tab")),
tabItem("Tab_1")
)
)
)
server <- function(input, output, session) {
callModule(value_box,
"tab",
.value = 33,
.subtitle = "Tab 1",
.tab.name = "Tab_1")
}
shinyApp(ui, server)
You can find the answer in this post: Accessing parent namespace inside a shiny module
Basically, in updateTabItems() inside a moulde, you need to call the parent's session, not the session of the modul.
Thus, add a variable for your session to callModule() and call it in updateTabItems().

Pop up a shinyFiles dialog R Shiny without a shinyFiles button

I would like to have one of the tabPanels in my Shiny app launch a shinyFiles style input. In this case I would like to launch a shinySaveButton, without the shinySaveButton being in my dataset (By clicking the save icon [which is actually a tabPanel])
Reproducible example below
library(shiny)
library(shinyFiles)
ui <- navbarPage('Test App',id = "inTabset", selected="panel1",
tabPanel(title = "", value = "Save", icon = icon("save")),
tabPanel(title = "Panel 1", value = "panel1",
h1("Panel1")),
tabPanel(title = "Panel 2",value = "panel2",
h1("Panel2"))
)
server <- function(input, output, session) {
values = reactiveValues(tabSelected="panel1")
observe({
if (input$inTabset=="Save") {
updateNavbarPage(session,"inTabset",selected=values$tabSelected)
#CODE FOR LOADING SHINYFILES DIALOG IN HERE
} else {
values$tabSelected<-input$inTabset
}
})
}
shinyApp(ui, server)
Any help would be greatly appreciated.
Work around using hidden element trick
library(shiny)
library(shinyFiles)
library(shinyjs)
jsCode<-"shinyjs.saveButton=function(){ $('#buttonFileSaveHidden').click(); }"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jsCode),
navbarPage('Test App',id = "inTabset", selected="panel1",
tabPanel(title = "", value = "Save", icon = icon("save")),
tabPanel(title = "Panel 1", value = "panel1",
h1("Panel1")
),
tabPanel(title = "Panel 2",value = "panel2",
h1("Panel2"))
),
# HIDDEN BUTTON TO INITIATE THE SAVE
hidden(shinySaveButton( "buttonFileSaveHidden",
label="",
title="Save as ...",
list('hidden_mime_type'=c("R")),
class='hiddenButton')),
wellPanel( #ONLY INCLUDED TO DISPLAY OF PATH INFO OF THE CHOICE
h3('Current save path info'),
tableOutput('table')
)
)
server <- function(input, output, session) {
values = reactiveValues(tabSelected="panel1")
observe({
if (input$inTabset=="Save") {
updateNavbarPage(session,"inTabset",selected=values$tabSelected)
#CODE FOR LOADING SHINYFILES DIALOG IN HERE
js$saveButton()
} else {
values$tabSelected<-input$inTabset
}
})
shinyFileSave(input, "buttonFileSaveHidden", session=session, roots=c(wd="~"), filetypes=c('R') ) #hidden
# GET THE SAVE PATH CHOICE AND RECORD IT IN fp.dt.rv
fp.dt.rv<-reactiveVal("")
observeEvent(input$buttonFileSaveHidden,{
fp.dt<-parseSavePath(c(wd='~'), input$buttonFileSaveHidden)
fp.dt.rv(fp.dt) #or just use to immediately write.
})
# ONLY TO DISPLAY THE SAVE CHOICE
output$table <- renderTable(fp.dt.rv())
}
shinyApp(ui, server)

How to Switch Between NavBar Tabs with a Button R Shiny

I need the user to click a button and be taken to a different tabPanel of a navbarPage. Here is a simple app where this could be implemented. How can I achieve this?
ui <- shinyUI(
navbarPage('Test App',
tabPanel('Page 1',
p('This is the first tab'), br(),
actionButton('jumpToP2', 'Jump to Second Tab')
),
tabPanel('Page 2',
p('This is the second tab'),
actionButton('jumpToP1', 'Jump to First Tab')
)
)
)
server <- shinyServer(function(input, output){
observeEvent(input$jumpToP2,{
## Switch active tab to 'Page 2'
})
observeEvent(input$jumpToP1,{
## Switch active tab to 'Page 1'
})
})
shinyApp(ui, server)
You can use updateTabsetPanel to switch between different tabPanels. See the documentation and example codes at https://shiny.rstudio.com/reference/shiny/latest/updateTabsetPanel.html. The code below should fulfill your requirements.
ui <- navbarPage('Test App',id = "inTabset",
tabPanel(title = "Panel 1", value = "panel1",
actionButton('jumpToP2', 'Jump to Second Tab')),
tabPanel(title = "Panel 2", value = "panel2",
actionButton('jumpToP1', 'Jump to First Tab'))
)
server <- function(input, output, session) {
observeEvent(input$jumpToP2, {
updateTabsetPanel(session, "inTabset",
selected = "panel2")
})
observeEvent(input$jumpToP1, {
updateTabsetPanel(session, "inTabset",
selected = "panel1")
})
}
shinyApp(ui, server)
I'm not so sure that this really the best way for you to design your U... Do you know that tabPanel() will act pretty much the same way as an actionButton() will in this case?
ui <- navbarPage('Test App',id = "inTabset",
tabPanel(title = "Panel 1", uiOutput("panel1")),
tabPanel(title = "Panel 2", uiOutput("panel2"))
)
server <- function(input, output, session) {
output$panel1 <- renderUI({
#your UI data
})
output$panel2 <- renderUI({
#your UI data
})
}
shinyApp(ui, server)

Resources