I'm implementing a drill down in my app so that when user clicks on a data table new tab is opened showing details for the selected cell. I wanted to add auto bookmarking (url updates itself) to my app so I can send a link to a specific, newly generated tab but the tab is not restored correctly. I think the observer is not triggered during the restoration process. Any ideas on how to make it work?
Minimal example:
library(shiny)
library(DT)
library(shinydashboard)
ui <- function(request) {
dashboardPage(
dashboardHeader(title = "Drilldown not restoring"),
dashboardSidebar(disable = T),
dashboardBody(
tabsetPanel(id = "tabs",
tabPanel("Cars overview",
h1("Cars overview"),
div("Click any cell"),
br(),
DT::dataTableOutput("mtcars")
)
)
)
)
}
server <- function(input, output, session) {
# Generate data table
output$mtcars <- DT::renderDataTable({mtcars})
# Observe when row is selected and open new tab
observeEvent(input$mtcars_rows_selected, {
print("Trigger")
appendTab(inputId = "tabs",
tabPanel(
"Car details",
"Car detail info"
)
)
# Focus on newly created tab
updateTabsetPanel(session, "tabs", selected = "Car details")
})
# Enable bookmarking
observe({
reactiveValuesToList(input)
session$doBookmark()
})
onBookmarked(function(url) {
updateQueryString(url)
})
}
shinyApp(ui, server, enableBookmarking = "url")
Related
I want to create a new menuItem and a new plotOutput based on an actionButton, and the newly rendered plotOutput will display a plot based on the submitted value. I have successfully generated the menuItem and the numericInput widget with submitted value, but the plot and the corresponding tabItem is not showing.
Here is the workflow:
submit -> render a menuItem with a input object and a plotOutput -> the plotOutput will be display based on the rendered input object
The second procedure is successful but the rest of that is not working, the code is listed below:
library(shiny)
library(shinydashboard)
## ============================================ Define ui ==================================================
header1 <- dashboardHeader(
title = "My Dynamic Menu"
) #dashboardHeader
# DYNAMIC UI
sidebar1 <- dashboardSidebar(
sidebarMenu(
menuItem('aa',tabName = 'aa')
) ,
sidebarMenuOutput('bb')
) #dashboardSidebar
#
body1 <- dashboardBody(
tabItems(
tabItem(tabName = 'aa',
numericInput('num_input', 'number', value = 5),
actionButton('submit','Submit')),
tabItem(tabName = "main", uiOutput('eee')) # put a tabItem here
) #tabItems
) #dashboardBody
ui <- dashboardPage(header1, sidebar1, body1)
server <- function(input, output, session) {
dt<-eventReactive(input$submit, {
input$num_input * 5
})
observeEvent(input$submit, {
output$bb<-renderMenu({
sidebarMenu(
menuItem("Main", tabName = "main",
numericInput('ddd', 'input value', value = dt()),
numericInput('ggg', 'another input', value=dt()+5))
)
})
output$eee<-renderUI({
fluidRow(
p('hello'),
plotOutput('fff')
)
})
})
observeEvent({
input$ddd
input$ggg
},{
output$fff<-renderPlot({
plot(1:input$ddd, main=as.character(input$ggg))
})
})
} #server
## ============================================ Run application ============================================
shinyApp(ui, server)
Many thanks if this issue is addressed.
to be linked with a tabItem, menuItem should only contain menuSubItem. If you remove your two numeric inputs (ddd and ggg) then the main page is activated when you click on the newly created main menuitem. Mixing navigation and inputs is not a good idea.
You'd better move you inputs to your main tabItem or put them in a separate panel (not in the menu) in the sidebar.
added a uiOutput for inputs in ui
# DYNAMIC UI
sidebar1 <- dashboardSidebar(
sidebarMenu(
menuItem('aa',tabName = 'aa')
) ,
sidebarMenuOutput('bb'),
uiOutput("inputs")
) #dashboardSidebar
added a renderUI for this output in server
output$inputs <- renderUI(tagList(
numericInput('ddd', 'input value', value = dt()),
numericInput('ggg', 'another input', value=dt()+5)
))
and removed inputs from your renderMenu
output$bb<-renderMenu({
message("bb")
sidebarMenu(
menuItem("Main", tabName = "main")
)
})
You have to navigate manually to the main page though to display the plot
I am trying to implement something similar to this within the app and not at the browser level as described here.
After capturing the value of the new tab (tabPanel value) selected, could not display the confirmation message before switching to the newly selected tab to display its content.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(id = "tabselected",
tabPanel("Tab1"),
tabPanel("Tab2",plotOutput("plot"))
)
)
server <- function(input, output) {
observeEvent(input$tabselected, {
if(input$tabselected == "Tab2")
{
shinyalert(title = "Save your work before changing tab", type = "warning", showConfirmButton = TRUE)
output$plot <- renderPlot({ ggplot(mtcars)+geom_abline() })
}
})
}
shinyApp(ui = ui, server = server)
You can simply redirect to Tab1 via updateTabsetPanel as long as your desired condition is met.
Here is an example requiring the user to type something in the textInput before it's allowed to switch the tab.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(
id = "tabselected",
tabPanel("Tab1", p(), textInput("requiredText", "Required Text")),
tabPanel("Tab2", p(), plotOutput("plot"))
))
server <- function(input, output, session) {
observeEvent(input$tabselected, {
if (input$tabselected == "Tab2" && !isTruthy(input$requiredText)) {
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE)
output$plot <- renderPlot({
ggplot(mtcars) + geom_abline() + ggtitle(req(input$requiredText))
})
}
})
}
shinyApp(ui = ui, server = server)
By the way an alternative approach wpuld be using showTab and hideTab to display the tabs only if all conditions are fulfilled.
This is the minimum reproducible example needed to help:
ui.R
library(shiny)
fluidPage(
title = 'DataTables Information',
tabsetPanel(id = "tabs",
tabPanel("Cars overview",
h1("Cars overview"),
div("Click any cell"),
br(),
DT::dataTableOutput("x4")
)
)
)
Server script:
server.R
library(shiny)
library(DT)
shinyServer(function(input, output, session) {
output$x4 = DT::renderDataTable({
DT::datatable(mtcars, selection = 'single')
}, server = TRUE)
observeEvent(input$x4_cells_clicked, {
print("Trigger")
value <- x4_cells_clicked$value
details <- mtcars %>%
filter(mpg == value)
appendTab(inputId = "tabs",
tabPanel(
DT::renderDataTable(DT::datatable(details), server = TRUE)
)
)
# Focus on newly created tab
updateTabsetPanel(session, "tabs", selected = "Car details")
})
})
What I am trying to accomplish is to trigger an event through a cell click on the mtcars dataframe. I want to append a tab upon a click and filter the dataframe that is produced by the value within the cell that is clicked. I know in this case I am only accounting for a click on the mpg column but I just need to see how a click on a cell is registered through observeEvent and how to use the value of the cell clicked to filter the dataframe that is produced in the new tab.
library(shiny)
library(DT)
ui <- fluidPage(
title = 'DataTables Information',
tabsetPanel(id = "tabs",
tabPanel("Cars overview",
h1("Cars overview"),
div("Click any cell"),
br(),
DTOutput("x4")
)
)
)
server <- function(input, output, session) {
output$x4 = renderDT({
datatable(mtcars, selection = 'single')
}, server = TRUE)
observeEvent(input$x4_cell_clicked, {
cell <- input$x4_cell_clicked
if(length(cell)){
details <- mtcars[mtcars[[cell$col]]==cell$value,]
appendTab(inputId = "tabs",
tabPanel(
"Cars details",
renderDT(datatable(details), server = TRUE)
),
select = TRUE # Focus on newly created tab
)
}
})
}
shinyApp(ui, server)
I want to jump to a certain page of an embedded PDF in shiny. I use tags$iframe to display the PDF. I know that I have to expand the URL in tags$iframe to jump to a certain page of the PDF by adding #page=x, i.e. tags$iframe(style="height:785px; width:100%", src="http://www.pdf995.com/samples/pdf.pdf#page=3").
However, if I have multiple tabs and switch from tab 1 to tab 2 and back to tab 1, the PDF always shows page 1. I could reload the whole tab/PDF to jump back to page 3, but I don't want to do that!
I tried to use JavaScript but it doesn't work because document.getElementById doesn't work properly.
My code so far
library(shiny)
library(shinyjs)
ui <- tagList(
useShinyjs(),
tags$script('Shiny.addCustomMessageHandler("go_to_page", function(message) {
document.getElementById("show_pdf").contentWindow.PDFViewerApplication.page = 3;
});'),
fluidPage(
fluidRow(
column(6,
tabsetPanel(id = "tabs",
tabPanel(
"Tab 1",
uiOutput("show_pdf")
),
tabPanel(
"Tab 2",
uiOutput("show_pdf1"))
)
)
))
)
server <- function(input, output, session){
output$show_pdf <- renderUI({
tags$iframe(style="height:785px; width:100%", src="http://www.pdf995.com/samples/pdf.pdf#page=3")
})
output$show_pdf1 <- renderUI({
tags$iframe(style="height:785px; width:100%", src="http://www.pdf995.com/samples/pdf.pdf#page=4")
})
observe({
input$tabs
session$sendCustomMessage(type = 'go_to_page', message = runif(1))
})
}
shinyApp(ui = ui, server = server)
What do I have to change so that the code works properly?
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().