im trying to invoke js across different tabs in shiny like the code below
library(shiny)
library(shinyjs)
ui <- tagList(
useShinyjs(),
navbarPage(
"shinyjs with navbarPage",
tabPanel("tab1",
actionLink(inputId = 'link',label = 'Fast Forward')
),
tabPanel("tab2",
actionButton("button", "Click me"),
textInput(inputId = "hello", label='',value = "Hello!")
)
)
)
server <- function(input, output, session) {
observeEvent(input$link, {
runjs('$("#link").click();')
})
observeEvent(input$button,{
toggle("hello")
})
}
shinyApp(ui, server)
the command is not going through, what could be the problem?
Try with this modified server part:
server <- function(input, output, session) {
observeEvent(input$link, {
runjs("$('a[data-value=\"tab2\"]').tab('show');")
})
observeEvent(input$button,{
toggle("hello")
})
}
i found the mistake.
i wrote
runjs('$("#link").click();')
instead of
runjs('$("#button").click();')
Related
I'm trying to output a table via tableHTML that depends on some input in a Shiny app. In the example below, I want the table to depend on the radio button. I'm getting an error saying "Error: no function to return from, jumping to top level", so it seems it doesn't like my two return-statements. Any ideas how to go about this?
library(shiny)
library(tableHTML)
ui = fluidPage(
fluidRow(
radioButtons("radio", label = h3("Data on/off"),
choices = list("On", "Off"),
selected = "Off"),
tableHTML_output("mytable")
)
)
server = function(input, output) {
output$mytable <- render_tableHTML({
if ((input$radio == "On")) {
return(tableHTML(mtcars))
}
else {
return(NULL)
}
})
}
shinyApp(ui, server)
The above works when replacing tableHTML_output by tableOutput and render_tableHTML by renderTable and removing the tableHMTL() function.
It seems a package related issue.
Since we are dealing with plain html, we can use shiny::htmlOutput.
library(shiny)
library(tableHTML)
ui <- fluidPage(
fluidRow(
radioButtons("radio",
label = h3("Data on/off"),
choices = list("On", "Off"),
selected = "On"
),
htmlOutput("mytable")
)
)
server <- function(input, output) {
html_table <- eventReactive(input$radio, {
table <- if (input$radio == "On") {
tableHTML(mtcars)
}
return(table)
})
output$mytable <- renderText(
html_table()
)
}
shinyApp(ui, server)
Another workaround is to have two render_tableHTML inside an observeEvent like this:
library(shiny)
library(tableHTML)
ui <- fluidPage(
fluidRow(
radioButtons("radio",
label = h3("Data on/off"),
choices = list("On", "Off"),
selected = "Off"
),
tableHTML_output("mytable")
)
)
server <- function(input, output) {
observeEvent(input$radio, {
if (input$radio == "On") {
output$mytable <- render_tableHTML({
tableHTML(mtcars)
})
} else {
output$mytable <- render_tableHTML({
NULL
})
}
})
}
shinyApp(ui, server)
Is there a way to make sure either of the action buttons are pressed, the event should trigger. In the below example, the output is to be printed when either of the buttons pressed
library(shiny)
ui <- fluidPage(
actionButton("act1", "Action1"),
actionButton("act2", "Action2"),
htmlOutput("gh")
)
server <- function(input, output, session) {
observeEvent((input$act1 | input$act2),{
output$gh <- renderUI({
"Clicked"
})
})
}
shinyApp(ui, server)
Yes, observeEvent has other arguments such as ignoreInit, just set it to TRUE
library(shiny)
ui <- fluidPage(
actionButton("act1", "Action1"),
actionButton("act2", "Action2"),
htmlOutput("gh")
)
server <- function(input, output, session) {
observeEvent((input$act1 | input$act2),{
output$gh <- renderUI({
"Clicked"
})
},ignoreInit = TRUE)
}
shinyApp(ui, server)
Is there a way to add a icon next to "Country" and when the user hover on it, it should show some text
library(shiny)
ui <- fluidPage(
selectInput("Sel","Sel",choices = 1:100),
htmlOutput("Sd")
)
server <- function(input, output, session) {
output$Sd <- renderUI({
"Country"
})
}
shinyApp(ui, server)
library(shiny)
library(shinyBS)
ui <- fluidPage(
selectInput("Sel","Sel",choices = 1:100),
htmlOutput("Sd")
)
server <- function(input, output, session) {
output$Sd <- renderUI({
tags$span(
"Country ",
tipify(
icon("bar-chart"),
"Hello, I am the tooltip!"
)
)
})
}
shinyApp(ui, server)
With a bit of HTML and CSS
Then you can use CSS to customize the hovering text
library(shiny)
ui <- fluidPage(
# Add CSS
tags$head(
tags$style(HTML("
#an_icon .text {
position:relative;
bottom:30px;
left:0px;
visibility:hidden;
}
#an_icon:hover .text {
visibility:visible;
}
"))
),
selectInput("Sel","Sel",choices = 1:100),
htmlOutput("Sd"),
# HTML for the icon
tags$div(id = 'an_icon',
icon("bar-chart"),
tags$span(class = "text", tags$p("text")))
)
server <- function(input, output, session) {
output$Sd <- renderUI({
"Country"
})
}
shinyApp(ui, server)
I am attempting to exclude a ShinyJS delay from a reactive bookmarking context in Shiny. I see that the delay ID in the URL is autogenerated and always different: delay-ad190e10123bd97f960fed7a8a9e6fde=3000.
I attempted to exclude the delay via regular expression, however I don't believe the regex is being parsed:
setBookmarkExclude(
c("delay-[[:alnum:]]"))
I would like a way to either set the ID on the delay so it is the same every time or to regex the setBookmarkExclude to exclude the randomly generated delay ID
Please see the following example:
library(shiny)
library(shinyjs)
ui <- function(request) {
fluidPage(
useShinyjs(),
br(),
bookmarkButton(id="bookmarkBtn"),
hr(),
textOutput("ExcludedIDsOut"),
hr(),
sliderInput(inputId="slider", label="My value will be bookmarked", min=0, max=10, value=5),
textOutput("out_1"),
textOutput("out_2"),
textOutput("out_3")
)
}
server <- function(input, output, session) {
observeEvent(input$bookmarkBtn, {
session$doBookmark()
})
ExcludedIDs <- reactiveVal(value = NULL)
observe({
toExclude <- "bookmarkBtn"
delayExclude <- grep("delay", names(input), value = TRUE)
if(length(delayExclude) > 0){
toExclude <- c(toExclude, delayExclude)
}
setBookmarkExclude(toExclude)
ExcludedIDs(toExclude)
})
output$ExcludedIDsOut <- renderText({
paste("ExcludedIDs:", paste(ExcludedIDs(), collapse = ", "))
})
delay(1000, {
output$out_1 <- renderText({
"My"
})
})
delay(2000, {
output$out_2 <- renderText({
"delayed"
})
})
delay(3000, {
output$out_3 <- renderText({
"output"
})
})
}
enableBookmarking(store = "url") # store = "server"
shinyApp(ui, server)
Update: Whitelist approach
library(shiny)
library(shinyjs)
ui <- function(request) {
fluidPage(
useShinyjs(),
br(),
bookmarkButton(id="bookmarkBtn"),
hr(),
textOutput("ExcludedIDsOut"),
hr(),
sliderInput(inputId="slider", label="My value will be bookmarked", min=0, max=10, value=5),
textOutput("out_1"),
textOutput("out_2"),
textOutput("out_3")
)
}
server <- function(input, output, session) {
bookmarkingWhitelist <- c("slider")
observeEvent(input$bookmarkBtn, {
session$doBookmark()
})
ExcludedIDs <- reactive({
toExclude <- setdiff(names(input), bookmarkingWhitelist)
setBookmarkExclude(toExclude)
toExclude
})
output$ExcludedIDsOut <- renderText({
paste("ExcludedIDs:", paste(ExcludedIDs(), collapse = ", "))
})
delay(1000, {
output$out_1 <- renderText({
"My"
})
})
delay(2000, {
output$out_2 <- renderText({
"delayed"
})
})
delay(3000, {
output$out_3 <- renderText({
"output"
})
})
}
enableBookmarking(store = "url") # store = "server"
shinyApp(ui, server)
Here is a related GitHub issue, note session$getBookmarkExclude() as an alternative to keep track of the excluded inputs.
I am looking for a code snippet using which, I can enable/disable sidebar toggle button in shinydashboard header.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- shinyUI(dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
useShinyjs()
)
))
server <- shinyServer(function(input, output, session) {
addClass(selector = "body", class = "sidebar-collapse") # Hide Side Bar
})
shinyApp(ui = ui, server = server)
Let me know if anybody can help???
If you use the shinyjs package, you can show or hide the sidebar toggle with a quick line of JavaScript.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- shinyUI(dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
useShinyjs(),
actionButton("hide","Hide toggle"),
actionButton("show","Show toggle")
)
))
server <- shinyServer(function(input, output, session) {
observeEvent(input$hide,{
shinyjs::runjs("document.getElementsByClassName('sidebar-toggle')[0].style.visibility = 'hidden';")
})
observeEvent(input$show,{
shinyjs::runjs("document.getElementsByClassName('sidebar-toggle')[0].style.visibility = 'visible';")
})
})
shinyApp(ui = ui, server = server)
The JavaScript itself just refers to the first element with class sidebar-toggle (i.e. the menu button), and toggles the visibility depending on which button the user presses.
I have found a solution to this...If someone is stuck with same problem, can refer to below solution:
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- shinyUI(dashboardPage(
dashboardHeader(),
dashboardSidebar( tags$head(
tags$script(
HTML(#code for hiding sidebar tabs
"Shiny.addCustomMessageHandler('manipulateMenuItem1', function(message)
{
var aNodeList = document.getElementsByTagName('a');
for (var i = 0; i < aNodeList.length; i++)
{
if(aNodeList[i].getAttribute('data-toggle') == message.toggle && aNodeList[i].getAttribute('role') == message.role)
{
if(message.action == 'hide')
{
aNodeList[i].setAttribute('style', 'display: none;');
}
else
{
aNodeList[i].setAttribute('style', 'display: block;');
};
};
}
});"
)
)
)
),
dashboardBody(
useShinyjs(),
actionButton("h1","Hide toggle"),
actionButton("h2","Show toggle")
)
))
server <- shinyServer(function(input, output, session) {
observeEvent(input$h1,{
session$sendCustomMessage(type = "manipulateMenuItem1", message = list(action = "hide",toggle = "offcanvas", role = "button"))
})
observeEvent(input$h2,{
session$sendCustomMessage(type = "manipulateMenuItem1", message = list(action = "show",toggle = "offcanvas", role = "button"))
})
})
shinyApp(ui = ui, server = server)