I want to understand how we can interact server section of code with pure JS (or Jquery). I prepared two examples - Basically I want to hide h4( ) on clicking of button by user. First example works as expected but second one does not work as h4() is in renderUI( ) in server. I know this can be solved via observeEvent or shinyJS package but I am more interested to make it work with pure JS not running JS code in server.
Example 1
library(shiny)
ui <- fluidPage(
fluidRow(
h4("Testing"),
actionButton("Disable", "Disable Element"),
tags$script("
$(document).ready(function() {
$('#Disable').click(function(){
$('h4').css('display', 'none');
});
})")
)
)
shinyApp(ui, server = function(input, output) { })
Example 2
ui <- fluidPage(
fluidRow(
h4("Testing"),
uiOutput("myfun"),
tags$script("
$(document).ready(function() {
$('#Disable').click(function(){
$('h4').css('display', 'none');
});
})")
)
)
shinyApp(ui, server = function(input, output) {
output$myfun <- renderUI({
tagList(
actionButton("Disable", "Disable Element")
)
})
})
One option is to add an onclick event to the button itself.
ui <- fluidPage(
fluidRow(
h4("Testing"),
uiOutput("myfun"),
tags$script("hideH4 = function() {$('h4').css('display', 'none');}")
)
)
shinyApp(ui, server = function(input, output) {
output$myfun <- renderUI({
tagList(
actionButton("Disable", "Disable Element", onclick="hideH4()")
)
})
})
Or add a document event hadler for the click and check the ID
ui <- fluidPage(
fluidRow(
h4("Testing"),
uiOutput("myfun"),
tags$script("
$(document).click(function(evt) {
if (evt.target.id=='Disable') {
$('h4').css('display', 'none');
}})")
)
)
shinyApp(ui, server = function(input, output) {
output$myfun <- renderUI({
tagList(
actionButton("Disable", "Disable Element")
)
})
})
Related
I am having a shiny app with some ui elements.
Is there a way to replace some HTML (e.g. div / div content) with an animation effect, similar to what shinyjs::show(anim=T) does?
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
actionButton("change","change"),
tags$div(id="someDiv",
"test"),
hidden(tags$div(id="withAnim", "Displayed with animation"))
)
server <- function(input, output) {
observeEvent(input$change, {
shinyjs::html("someDiv", "changed without animation")
shinyjs::delay(1000, show("withAnim", anim=T, animType="fade"))
})
}
shinyApp(ui = ui, server = server)
the shinyjs::html doesn't provide this utility. We can write our own js code and use shinyjs::runjs to run it when button is clicked.
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
actionButton("change","change"),
tags$div(id="someDiv",
"test"),
hidden(tags$div(id="withAnim", "Displayed with animation"))
)
server <- function(input, output) {
observeEvent(input$change, {
shinyjs::runjs("$('#someDiv').fadeOut(500, function(){$(this).text('changed without animation').fadeIn();})")
shinyjs::delay(1000, show("withAnim", anim=T, animType="fade"))
})
}
shinyApp(ui = ui, server = server)
I have two modals. When the first is opened, the background should be grayed out, as is default. But this should not happen with the second one. The code is:
library(shiny)
ui <- fluidPage(
tags$style(type = 'text/css', '.modal-backdrop { display: none }'),
actionButton('modal1', 'Modal1'),
actionButton('modal2', 'Modal2'),
)
server <- function(input, output) {
observeEvent(input$modal1,
showModal(modalDialog(title = "Modal1"))
)
observeEvent(input$modal2,
showModal(modalDialog(title = "Modal2"))
)
}
shinyApp(ui = ui, server = server)
The css code should be connected to the id of the second modal dialog, but it is not possible to include an id in the function 'modalDialog'.
Any ideas about how to apply the css code selectively to only the second modal?
You can add JS code to hide the backdrop after showing the second modal using tags$script just after modalDialog.
library(shiny)
ui <- fluidPage(
actionButton('modal1', 'Modal1'),
actionButton('modal2', 'Modal2'),
)
server <- function(input, output) {
observeEvent(input$modal1,
showModal(modalDialog(title = "Modal1"))
)
observeEvent(input$modal2, {
showModal(
list(
modalDialog(title = "Modal2"),
tags$script("$('.modal-backdrop').css('display', 'none');")
)
)
})
}
shinyApp(ui = ui, server = server)
I am trying to use a button to change pages in a shiny app. I have found examples like this one that seem pretty straight forward but for some reason I am not able to make it work. Below is a reproducible example I created in an app.R file. This creates a two page app with a button on the first page but clicking the button does not move you to the second page. Any tips would be greatly appreciated.
pageButtonUi <- function(id) {
actionButton(NS(id, "page_change"),
label="Change the Page")
}
pageButtonServer <- function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(input$page_change, {
updateNavbarPage(session=session,
inputId="pages",
selected="second_page")
})
})
}
ui <- navbarPage(
title="test",
id="pages",
tabPanel(title="first page",
sidebarLayout(
sidebarPanel(
pageButtonUi("page")
),
mainPanel(
)
)
),
tabPanel(title="second_page", "second_page")
)
server <- function(input, output, session) {
pageButtonServer("page")
}
shinyApp(ui, server)
You are using shiny modules. The tabPanel is defined in the top-level UI, but your are trying to use a lower-level (module) server to update the top-level UI. This will not work. So you need to use top-level server to update top-level UI. In other words, you need to pass the parent session object to your module.
This is how to fix:
library(shiny)
pageButtonUi <- function(id) {
actionButton(NS(id, "page_change"),
label="Change the Page")
}
pageButtonServer <- function(id, parentSession) {
moduleServer(id, function(input, output, session) {
observeEvent(input$page_change, {
updateNavbarPage(session=parentSession,
inputId="pages",
selected="second_page")
})
})
}
ui <- navbarPage(
title="test",
id="pages",
tabPanel(title="first page",
sidebarLayout(
sidebarPanel(
pageButtonUi("page")
),
mainPanel(
)
)
),
tabPanel(title="second_page", "second_page")
)
server <- function(input, output, session) {
pageButtonServer("page", parentSession = session)
}
shinyApp(ui, server)
This is not easy to understand even for advanced users. Try to read Rstudio articles see how they define session will be helpful.
I read all the threads about dynamic ui within the Shiny framework, but I did not find anything that work. I want to display a twitter timeline. This chunk of code works really well :
library(shiny)
library(shinydashboard)
runApp(list(ui = fluidPage(
tags$head(tags$script('!function(d,s,id){var js,fjs=d.getElementsByTagName(s) [0],p=/^http:/.test(d.location)?\'http\':\'https\';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+"://platform.twitter.com/widgets.js";fjs.parentNode.insertBefore(js,fjs);}}(document,"script","twitter-wjs");')),
titlePanel(""),
sidebarLayout(
sidebarPanel()
, mainPanel(
a("Tweets by Andrew Ng",
class="twitter-timeline",
href = "https://twitter.com/AndrewYNg"
)
)
)
)
, server = function(input, output, session){
}
)
)
But when, I try to make it reactive, I only got a link to the twitter timeline:
library(shiny)
library(shinydashboard)
runApp(list(ui = fluidPage(
tags$head(tags$script('!function(d,s,id){var js,fjs=d.getElementsByTagName(s) [0],p=/^http:/.test(d.location)?\'http\':\'https\';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+"://platform.twitter.com/widgets.js";fjs.parentNode.insertBefore(js,fjs);}}(document,"script","twitter-wjs");')),
titlePanel(""),
sidebarLayout(
sidebarPanel()
, mainPanel(
uiOutput("mytimeline")
)
)
)
, server = function(input, output, session){
output$mytimeline <- renderUI({
a("Tweets by Andrew Ng",
class="twitter-timeline",
href = "https://twitter.com/AndrewYNg"
)
})
}
)
)
The Twitter script only loads embedded content when it runs the first time. Since the script is in static UI but the timeline is in dynamic UI, the script will always run before the timeline is inserted.
The Twitter docs have a section about this: https://dev.twitter.com/web/javascript/initialization
You can run twttr.widgets.load() to scan the page for newly added embedded content.
One way to run execute this when inserting embedded content would be to include it in a script tag:
library(shiny)
twitterTimeline <- function(href, ...) {
tagList(
tags$a(class = "twitter-timeline", href = href, ...),
tags$script("twttr.widgets.load()")
)
}
runApp(list(ui = fluidPage(
tags$head(tags$script('!function(d,s,id){var js,fjs=d.getElementsByTagName(s) [0],p=/^http:/.test(d.location)?\'http\':\'https\';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+"://platform.twitter.com/widgets.js";fjs.parentNode.insertBefore(js,fjs);}}(document,"script","twitter-wjs");')),
titlePanel(""),
sidebarLayout(
sidebarPanel()
, mainPanel(
uiOutput("mytimeline")
)
)
)
,
server = function(input, output, session) {
output$mytimeline <- renderUI({
twitterTimeline("https://twitter.com/AndrewYNg", "Tweets by Andrew Ng")
})
}
))
See How to enable syntax highlighting in R Shiny app with htmlOutput for a similar issue with more details
I have RShiny code, with which i want to disable/enable number input with checkbox. However, it works only for disable.
library(shiny)
runApp(shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
numericInput("test", "Test", 5),
checkboxInput("submit", label="Choose")
),
server = function(input, output, session) {
observeEvent(input$submit, {
shinyjs::disable("test")
})
}
))
How could I fix that?
Your code is mostly correct. The bug is in what you are observing. Your code would work fine if you are using an action button. But for the checkbox, you need to disable the input when the checkbox is unchecked, and enable when checked, and not just observe the event.
library(shiny)
runApp(shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
numericInput("test", "Test", 5),
checkboxInput("submit", label="Choose")
),
server = function(input, output, session) {
observeEvent(input$submit, {
if(input$submit == F){
shinyjs::disable("test")
} else {
shinyjs::enable("test")
}
})
}
))