Include a JavaScript File in Shiny App

Include a javascript file in Shiny app

What you need to do is:

  1. create www folder in the same folder as server.R and ui.R
  2. put javascript file into www folder.
  3. put tags$head(tags$script(src="hoge.js")) in UI.

The folder looks like:

├── server.R
├── ui.R
└── www
└── hoge.js

The ui.R is something like

library(shiny)
shinyUI(pageWithSidebar(
headerPanel("New Application"),
sidebarPanel(
sliderInput("obs",
"Number of observations:",
min = 1,
max = 1000,
value = 500)
),
mainPanel(
plotOutput("distPlot"),
tags$head(tags$script(src="hoge.js"))
)
))

and server.R

library(shiny)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
dist <- rnorm(input$obs)
hist(dist)
})
})

Note that these are templates generated by Rstudio.

Now head of html looks like:

<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>
... snip ...
<script src="shared/slider/js/jquery.slider.min.js"></script>
<script src="hoge.js"></script>
</head>

How to include a remote JavaScript file in a shiny dashboard app?

You can include remote JS files using the src argument of a script tag

library(shiny)
jsfile <- "https://gist.githack.com/daattali/7519b627cb9a3c5cebcb/raw/91e8c041d8fe4010c01fe974c6a35d6dd465f92f/jstest.js"

runApp(shinyApp(
ui = fluidPage(
tags$head(tags$script(src = jsfile))
),
server = function(input, output) {
}
))

EDIT: Ok, so you want this to work with a shinydashboard. It makes sense why your way doesn't work. Look at the documentation for dashboardPage. The first argument is header. You can't just start providing tags/UI elements you want to include. The includescript or any other such elements should go inside the dashboardBody. For example

library(shiny)
library(shinydashboard)
jsfile <- "https://gist.githack.com/daattali/7519b627cb9a3c5cebcb/raw/91e8c041d8fe4010c01fe974c6a35d6dd465f92f/jstest.js"

runApp(shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
tags$head(tags$script(src = jsfile))
)
),
server = function(input, output) {
}
))

Shiny: unable to render a js file

Here is the working code:

library(shiny)
ui <- navbarPage("",
tabPanel("exp",id = 'exp',
fluidPage(
fluidRow("i",uiOutput("vid"))
))
)
server <- function(input, output,session) {

output$vid <- renderUI({
tagList(
tags$video(
id='myvideo',type = 'video/mp4',
src = "http://www.w3schools.com/html/mov_bbb.mp4",
controls="controls",controlsList="nodownload",
autoplay ="autoplay",muted="muted"),
tags$script(
'
var myvid = document.getElementById("myvideo");
var myvids = [
"http://www.w3schools.com/html/mov_bbb.mp4",
"http://www.w3schools.com/html/movie.mp4"
];
var activeVideo = 0;

myvid.addEventListener("ended", function(e) {
// update the active video index
console.log("Video stopped")
activeVideo = (++activeVideo) % myvids.length;

// update the video source and play
myvid.src = myvids[activeVideo];
myvid.play();
});
'
)
)
})
}
shinyApp(ui, server)

Here are the two key points:

  1. If you want to use renderUI, the script has to go into the render expression as well. You can't leave in the UI. The script is been run when the UI is constructed, but here we want to wait till the video tag is rendered.
  2. In the video tag, you shouldn't use loop = "loop". This will cause the video "ended" event to never be triggered (it's looping, but not ending). In the script, the loop behavior is controlled by myvid.play() command.

Bonus tip: you may want to set the width and height of your video tag. Different videos have different dimensions. If you let it set automatically, you will see the video element size changes between videos on your UI. Fixing the width and height may give your users a better experience.

Sending Javascript in Shiny

If you are using shiny input components and would like to update the value of an input element by some other means (e.g., button click), then use one of the update- functions (available in the shiny package). However, it is unlikely that these update functions will work (or are even available) for non-Shiny widgets.

One alternative is to create a custom input binding where data is sent between Shiny and the client. This approach is best for custom input components or for creating wrappers around existing component libraries (non-R/Shiny packages). (For more information, checkout the following RStudio guides Building Custom Input Objects and How to create custom input bindings. I won't go into detail here about input bindings as it would make for a long answer).

Messages can be sent from Shiny to the client using session$sendInputMessage(). In the input binding (written using jQuery; vanilla JS won't work), use the receiveInputMessage method to retrieve and respond to the data. Using the example provided in your question, I provided a demo on how to update a custom select input widget in response to a button click.

Let me know if you have any questions!

library(shiny)

ui <- tagList(
tags$main(
tags$h1("Receive Message Input"),
tags$label(
`for` = "state",
"Select a State"
),
tags$select(
id = "state",
class = "select__input",
tags$option(value = "NONE", "--- Select ---"),
tags$option(value = "NY", "New York"),
tags$option(value = "NJ", "New Jersey"),
tags$option(value = "CT", "Connecticut")
),
tags$button(
id = "state_ny",
class = "shiny-bound-input action-button",
"Select New York"
),
tags$button(
id = "state_nj",
class = "shiny-bound-input action-button",
"Select New Jersey"
),
tags$button(
id = "state_reset",
class = "shiny-bound-input action-button",
"Reset"
)
),
tags$script(
type = "text/javascript",
HTML(
"const myCustomBinding = new Shiny.InputBinding();",
"$.extend(myCustomBinding, {
find = function(scope) {
return $(scope).find('.select__input');
},
getValue = function(el) {
return $(scope).value;
},
subscribe = function(el, callback) {
$(el).on('change', function(e) {
callback();
});
},
receiveInputMessage = function(el, message) {
if (message.type === 'update') {
$(el).value = data.value
}
},
unsubscribe = function(el) {
$(el).off('myCustomBinding');
}
});",
"Shiny.inputBindings.register(myCustomBinding);"
)
)
)

server <- function(input, output, session) {

# server-side function for sending data for use in `receiveInputMessage`
setSelectValue <- function(inputId, value) {
session$sendInputMessage(
inputId = inputId,
message = list(
type = "update",
value = value
)
)
}

# onClick Events
observeEvent(input$state_ny, setSelectValue("state", "NY"))
observeEvent(input$state_nj, setSelectValue("state", "NJ"))
observeEvent(input$state_reset, setSelectValue("state", "NONE"))

observe(print(input$state))
}

shinyApp(ui, server)


Related Topics



Leave a reply



Submit