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?
Related
I have a simple problem with Shiny: I'm using a navbarPage layout, and I have two different sidebars. I want the sidebar to be conditional on which page of the app the user is on.
That seems easy enough, and the following approach works fine at changing the sidebar panel, but with this approach my tab headers drop down from the top navbar and into the main panel. I Have tried various approaches to get them back into the navbar, which all haven't worked.
Suspect there's a very simple solution, any help gratefully received!
library(shiny)
ui <- navbarPage(title = "example",
sidebarLayout(
sidebarPanel(
conditionalPanel(condition = 'input.tabs==1',"sidebar 1"),
conditionalPanel(condition = 'input.tabs==2 | input.tabs==3',"sidebars 2&3")),
mainPanel(tabsetPanel(id="tabs",
tabPanel("About",value=1, "hello 1"),
tabPanel("parameters",value=2, "hello 2"),
tabPanel("outputs",value=3, "hello 3")
))))
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
You don't need the tabsetPanel to achieve this, just assign the id to the navbarPage itself and see which one is clicked
library(shiny)
ui <- navbarPage(title = "example",
id = 'tabs',
tabPanel("About",value=1, "hello 1"),
tabPanel("parameters",value=2, "hello 2"),
tabPanel("outputs",value=3, "hello 3"),
sidebarPanel(
conditionalPanel(condition = 'input.tabs == 1',"sidebar 1"),
conditionalPanel(condition = 'input.tabs == 2 | input.tabs==3',"sidebars 2&3")
)
)
server <- function(input, output, session) {
observe({
print(input$tabs)
})
}
shinyApp(ui = ui, server = server)
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().
writing with a shiny question. I have a navbarPage, id = "navbar", and in the navbarMenu user can select one among several tabPanels. Each tabPanel is assigned a value (value = 1, value = 2, etc). So input$navbar is reactive value with the value of the selected tabPanel.
I have a reactive expression defined which reacts to the changing of the tabPanel (reacts based on input$navbar). What I actually want is for this to react to navigating to a particular tabPanel, but not navigating away from that tabPanel. So, when input$navbar changes from 1 to 2 I want a reaction, but when changing from 2 to 1 no reaction. How can I achieve this?
Here is relevant snippet of my code, I don't think I need a full reproducible example for this but let me know if I'm wrong.
#ui snippet
navbarPage(id = "navbar",
navbarMenu(title = "Title",
tabPanel(title = "tp1", value = 1),
tabPanel(title = "tp2", value = 2),
#more tabPanels and ui stuff...
#server snippet
rctvfx <- reactive({
#want this to react only when input$navbar changes from ==1 to ==2
input$navbar
isolate({
#do stuff
})
})
You can use an if statement. This makes sure the code only runs if the user navigated to the corresponding tab.
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
"----",
"Section header",
tabPanel("Table")
)
),
server = function(input, output){
observe({
if (req(input$navbar) == "Table")
message("Table has been selected")
if (req(input$navbar) == "Plot")
message("Plot has been selected")
})
}
)
I would recomment do use observe rather than reactive to make sure everything runs even if all observers for the reactive are idle.
Another example of the same answer as above
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
tabPanel("Table"),
mainPanel(dataTableOutput("d"))
)
),
server = function(input, output){
output$d = renderDataTable({
if ((input$navbar) == "Table") {
head(mtcars)
} else {
((input$navbar) == "Plot")
head(iris)
}
})
}
)
I'm working on a Shiny application that is supposed to handle multiple languages. I managed to dynamically translate almost all elements of the app depending on a selectInput to choose the language. However the "hard stuff" remains the navbarPage tabs as well as the tabPanels inside my pages. I cannot change their names. I tried this, but it does not work:
library(shiny)
ui <- navbarPage("App Title",
tabPanel("tab1",
selectInput("language", "language", c("EN", "FR"), width = '300px'),
textOutput("text")),
uiOutput("render_tab2"))
server <- function(input, output, session) {
output$text = renderText({ switch(input$language, "EN"="hello world", "FR"="bonjour monde") })
output$render_tab2 = renderUI({
tabPanel( title=switch(input$language, "EN"="tab2", "FR"="onglet2") )})}
shinyApp(ui, server)
And the updatenavbarpanel() family of functions are just to set the active tab, not change their characteristics...Is there a way to do it, if possible that does not change the structure of all my app... THanks a lot.
This piece of code set the title dynamically :
library(shiny)
ui <- navbarPage("App Title",
tabPanel(title = uiOutput("title_panel"),
selectInput("language", "language", c("EN", "FR"), width = '300px')
)
)
server <- function(input, output, session) {
output$title_panel = renderText({
switch(input$language, "EN"="hello world", "FR"="bonjour monde")
})
}
shinyApp(ui, server)
Edit : Works with both uiOutput("title_panel") & textOutput("title_panel")
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")