R Shiny HTML object is rendered on every tabPanel() - r

I am trying to create a shiny app where users can upload their own data and get a visualization of the network dynamics in their data. I'm using the render.d3movie() function from the ndtv package to create an HTML object from the network with some user input parameters. I want to display this HTML object in one of my tabPanel()s but weirdly, it shows up on every panel instead. I tried with a different HTML file and this one works just fine. To reproduce this, you'll need to download the test and network animation html files and put them in the same directory as the example shiny app code below.
Example:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
navbarPage("ShinyExample",
tabPanel("TEST", HTML("FirstPage"), includeHTML("test.html")),
tabPanel("TEST2", HTML("SecondPage"), includeHTML("NetworkAnimation.html"))
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# Stuff to render and save the network Animation happens here
}
# Run the application
shinyApp(ui = ui, server = server)
Expected Behavior:
test.html and NetworkAnimation.html should only be rendered within their respective tabPanel()
Observed Behavior:
test.html is only rendered in it's respective tabPanel() but NetworkAnimation.html is rendered on both tabPanel() s

The network-widget is appended to the body in the NetworkAnimation.html-Javascript:
target = d3.select('body').append('div').style({width: '100%', height: '100%'}).node();.
If you want it to be on Tab 2 only, you can include a div with id and change the JavaScript line, so that it gets appended to your div.
My App looks like this:
ui <- fluidPage(
## Include shinyjs
useShinyjs(),
## Set ID of navbarPage
navbarPage("ShinyExample", id = "navid",
tabPanel("TEST", includeHTML("test.html")),
tabPanel("TEST2",
## Include new DIV here & Set initial height
div(id="appendhere", style="height: 1090px;"),
includeHTML("NetworkAnimation.html"))
)
)
server <- function(input, output) {
observe({
req(input$navid == "TEST2")
runjs('$("#appendhere").resize()')
})
}
# Run the application
shinyApp(ui = ui, server = server)
and the JS is changed to
target = d3.select('#appendhere').append('div').style({width: '100%', height: '100%'}).node();
I also had to include shinyjs, to run some JavaScript when TAB2 is active. The width/height of the svg is calculated when it is rendered and therefore initially 0 (or actually -60).
If you remove the runjs line, you will see that the network is not visible.
By changing the browser size, the network gets redrawn and width/height are updated. Therefore we call $("#appendhere").resize() when TAB2 is active.
There is still the following error in the browser console, but everything seems to work fine.
Uncaught TypeError: a is undefined

Related

Shiny observeEvent shows first event, but not second, third

TL;DR: observeEvent is only working on the first instance, but not subsequent.
Explanation:
In a small shiny app below, I dynamically build a URL based on user input, which points to the corresponding pre-rendered "timer" gif images I have hosted on GH. In this shiny app code below, observeEvent works great to pull the sliderInput value (e.g. 5sec), build a URL, and then clicking 'go' will show the timer using a clever shinyjs package. However, if I do not change the input (still 5sec), clicking go doesn't rebuild the image. If I change the value to a different number (4sec), it will show the correct gif. If I change back to the original number (5sec), no gif. If I go to a new number (3sec), correct gif. If I print the value of input$time or of rv$time in my observeEvent, then each of those values are updating correctly (both print the corresponding value).
Goal: to show the gif that corresponds to the input$time upon each update of input$go
Reprex:
library(shiny)
library(tidyverse)
library(glue)
library(shinyjs)
# Define UI
ui <- navbarPage(title = "Reprex",
## RHYME TIME -----
tabPanel("Time",
useShinyjs(),
sidebarLayout(
sidebarPanel(
sliderInput("time",
"Seconds",
min = 3,
max = 10,
value = 5
),
actionButton(inputId = "go",
label = "Go"),
),
mainPanel(
HTML("<center>"),
shinyjs::hidden(htmlOutput("simple_timer")),
HTML("</center>")
)
)
)
)
# Define server logic
server <- function(input, output, session) {
#a container to store my time var
rv <- reactiveValues(
time = 0
)
#the event that is triggered by input$go getting clicked
observeEvent(input$go, {
rv$time <- input$time #this should update rv$time after go is clicked
shinyjs::show("simple_timer") #this is the clever package with simple show/hide funs
})
#the reactive text that generates my HTML
output$simple_timer <- renderText({
glue::glue('<img src ="https://github.com/matthewhirschey/time_timer/raw/main/data/{rv$time}_sec.gif",
align = "center",
height="50%",
width="50%">')
})
}
# Run the application
shinyApp(ui = ui, server = server)
There are a couple of issues with your code:
renderText won't refire if you press input$go again (w/o changing the slider). Becasue the idea is that observer/render fires whenever their reactives change. As your renderText depends on rv$time which does not change when input$time does not change, the render function is not fired on subsequent button presses. This can be remedied by including input$go in the render function setting an additional dependency on the button.
This will not, however, solve your problem, because the browser uses caching. It sees that the <img> tag did not change (same src), thus it does not reload the picture. To circumvent that you can use the trick from Disable cache for some images by adding a timestamp to the src.
To make a long story short, this code does the trick:
output$simple_timer <- renderText({
input$go # make code dependent on the button
# add `?timestamp=<timestamp>`to the src URL to convince the browser to reload the pic
glue::glue('<img src ="https://github.com/matthewhirschey/time_timer/raw/main/data/{rv$time}_sec.gif?timestamp={Sys.time()}",
align = "center",
height="50%",
width="50%">')
})

File selection window opens behind R main window

I saw this question has been asked before but not answered. When using tcltk::tk_choose.files() the first time during an R session it opens behind the R main window. All further times it opens in front of the main window (as it should!). Is there a way to have it always in the very front?
Ultimately I would like to use it via shiny as below. So it should also be in front of the shiny window.
library(shiny)
ui <- fluidPage(
actionButton("do", "Open window")
)
server <- function(input, output, session) {
observeEvent(input$do, {
tcltk::tk_choose.files()
})
}
shinyApp(ui, server)
I am aware of base::file.choose() and utils::choose.files(). However, the first does not allow to select multiple files at once and the second does not allow to copy/paste paths for quicker navigation which drives me crazy,..

How open PDF file in the same window as R Shiny application works?

How to load PDF file in same window of R Shiny application?
Here is an example:
library(shiny)
ui <- fluidPage(
navbarPage("Demo",
tabPanel("Overview", fluidPage(fluidRow("Overview page"))),
tabPanel("PDF file", fluidRow(uiOutput("load_pdf_file")))))
server <- function(input, output) {
# 1. Load PDF file
output$load_pdf_file <- renderUI({
# 1.1. This loads pdf file in a 'new' window
browseURL("http://www.africau.edu/images/default/sample.pdf")
# 1.2. How to load pdf file in the 'same' window where R Shiny app works
# Expect to see pdf file on the page in 'PDF file' section
# ...
})
}
shinyApp(ui = ui, server = server)
The method that I know of, does not rely on serving up PDF's it uses the standard HTML methods one would use in a traditional webpage, with the shiny code js wrappers to place it in an iFrame.
With this method, in the tabPanel you set up an iFrame and give it some dimension ( I picked arbitrary ones) the decide if it scrolls or not, the use src to supply it with the path to your pdf file. The condition of course is that your PDF file is discoverable by some kind of a local path or URL to the outside world.
library(shiny)
ui <- fluidPage(
navbarPage("Demo",
tabPanel("Overview", fluidPage(fluidRow("Overview page"))),
tabPanel("PDF file",
tags$iframe(style="height:800px;
width:200%;
scrolling=no",
src="https://your-path/your-file.pdf"))))

R shiny dynamically render audio [close]

I am working on a project, trying to render audio dynamically. That is, I can click a button and play a selected local audio.
I have read this post and tried zedii's trick. The problem remains still.
Well I build a test app as shown below.
library(shiny)
# test set ----
ui <- fluidPage(
textInput('my_music','path:',value="questionF"),
actionButton("ok", "Okay"),
uiOutput('my_audio')
# tags$audio(src = "questionF.mp3", type = "audio/mp3")
)
get_audio_tag <- function(filename) {
tags$audio(src = filename,
type = "audio/mp3",
controls = "controls")
}
server <- function(input, output, session){
# Render the audio player
observeEvent(input$ok, {
wav_name = input$my_music
# output$my_audio <-renderUI(get_audio_tag("questionF.mp3"))
output$my_audio <-renderUI(get_audio_tag(wav_name))
})
}
shinyApp(ui = ui, server = server)
When I click the button, the first song turns out okay. But the following ones seemed pretty hard to load, for my computer would freeze with the memory used by Rstudio rising.
Any thoughts will be appreciated.
updates:
I tried on different browsers. These codes would failed on Chrome but works fine on Microsoft edges.
Looks like a caching problem.
So now my question is how can I make the codes work on every platform using shiny/R?
My codes works on most browser other than Chrome. I think it's more like a Chrome's problem.

Duplicate an icon in shiny actionButton

I would like to add a Font Awesome 'child' icon twice in my actionButton in Shiny. The following app displays the child once:
library(shiny)
ui <- fluidPage(
actionButton("child","children", icon("child"))
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
I tried the obvious to no avail:
actionButton("child","children", icon(c("child","child")))
I must accept this is quite a niche question.
This has nothing to do with the fact that you want the same icon twice. You just can't pass a vector of names into the icon() function. If you look at the documentation of icon() it says it accepts the name of an icon, not a vector for multiple icons.
To do what you want, you can simply add multiple icons in the label. Something like this
actionButton("child", div(icon("child"), icon("child"), "children"))

Resources