Force draw of hidden table - r

I have the following app, which is just a collapse panel containing an rhandsontable table.
library(shiny)
library(shinyBS)
library(rhandsontable)
ui <- function() {
fluidPage(
bsCollapsePanel(
"Test",
rHandsontableOutput("table")
)
)
}
server <- function(input, output, session) {
output$table <- renderRHandsontable({
rhandsontable(
data.frame(
a = 1:2,
b = 2:3
)
)
})
}
shinyApp(ui, server)
It works as expected: the panel starts with its contents hidden, and if we click it the panel opens and we see the table.
However, there is a noticeable "lag" between the panel opening and the table appearing. I assume this is because the table hadn't been initialized until then, and so all the work actually creating the table only happens at that moment.
If we then close the panel and reopen it, there is no such lag and we can even gradually see the table as the panel reopens.
I don't know if this is a feature or a bug, or who's "fault" it is: rhandsontable, for being lazy in starting up? shinyBS, for being lazy starting its contents up? shiny in general, for only triggering redraws immediately when needed? I'd assume it's rhandsontable, since more basic elements like textInput() don't have this problem, but can't know for sure.
So, is there a way to force this initialization of the table when the app starts up, instead of only when the panel expands?
I've thought of setting the panel to start open and then hack the server to close the panel on startup, but I'm not entirely sure how that'd work... or if it'd even work (if it closes prior to the first redraw, what difference will it make? if it's after the first redraw, that'd imply a flicker on startup, right?).

I think this should do it:
server <- function(input, output, session) {
output$table <- renderRHandsontable({
rhandsontable(
data.frame(
a = 1:2,
b = 2:3
)
)
})
outputOptions(output, "table", suspendWhenHidden = FALSE)
}

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%">')
})

Shiny SelectInput and SelectizeInput

I updated my Shiny library to version 1.1.0 and I noticed some very strange behavior with selectInput/selectizeInput and observeEvent/eventReactive.
The problem occurs when I press backspace and clear the contents of the drop-down menu. In the previous Shiny version the backspace coupled with a eventReactive, the reactive expression wouldn't evaluate (I guess it treated this as a NULL) observe and reactive would evaluate which is desired.
req() is also behaving weird, in Example 1 below if we press the backspace and clear the input, renderTable is triggered but when req(input$variable) is empty the table disappears. In the previous version if Shiny I believe the table would simply remain the same.
Reproducing Code:
Example 1
shinyApp(
ui = fluidPage(
selectizeInput("variable", "Variable:",
c("Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear")),
tableOutput("data")
),
server = function(input, output) {
observeEvent(input$variable,{
cat("Printing: ",input$variable,"\n")
})
output$data <- renderTable({
req(input$variable)
Sys.sleep(2)
mtcars[, c("mpg", input$variable), drop = FALSE]
}, rownames = TRUE)
}
)
or
Example 2
This looks like okay behavior but if you notice the renderTable is still being called when the backspace is pressed. If this was an expensive computation it would be undesirable behavior.
shinyApp(
ui = fluidPage(
selectInput("variable", "Variable:",
c("Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear")),
tableOutput("data")
),
server = function(input, output) {
observeEvent(input$variable,{
cat("Printing: ",input$variable,"\n")
})
output$data <- renderTable({
req(input$variable)
Sys.sleep(2)
mtcars[, c("mpg", input$variable), drop = FALSE]
}, rownames = TRUE)
}
)
My desired behavior: When the backspace is pressed to clear the menu observeEvents and eventReactive are not triggered.
It seems like the current behavior triggers an event on backspace but the input value remains the same. This behavior could actually be an unintended change that happenend when the JavaScript function Shiny.onInputChange was updated. The NEWS on shinys github site claims the following under Version 1.1.
NEW FEATURES
[...]
Introduced two changes to the (undocumented but widely used) JavaScript function Shiny.onInputChange(name, value). First, we changed the function name to Shiny.setInputValue (but don't worry--the old function name will continue to work). Second, until now, all calls to Shiny.onInputChange(inputId, value) have been "deduplicated"; that is, anytime an input is set to the same value it already has, the set is ignored. With Shiny v1.1, you can now add an options object as the third parameter: Shiny.setInputValue("name", value, {priority: "event"}). When the priority option is set to "event", Shiny will always send the value and trigger reactivity, whether it is a duplicate or not.
The current version of selectInput seems to take advantage of this new {priority: "event"} option but that is just speculation.
Workaround
You can adapt your server code to correctly handle this new behavior by deduping the inputs yourself.
dedupedValue <- reactiveVal()
observe({ dedupedValue(input$value) })
Then you use dedupedValue() instead of input$value in the rest of your server code. This will also work with older versions of shiny.
NOTE: If you try to use reactive instead of observe in the above code it will not work.
Long term solution
Maybe it would be best to set this question on hold until the shiny devs took a look at your GitHub issue. As outlined above, the cause of this is probably an interface change on the JavaScript side of shiny. If this indeed created code breaking changes, I am sure the devs will provide a fix to ensure backwards compability.
About req
This is basically unrelated to the issue at hand but came up with your question: If you want req to retrain the old output if the condition is not "truthy", you should call it as
req(condition, cancelOuput = TRUE)

trigger R actionbutton event when session opens

In a Shiny app, I am trying to have an eventReactive triggered either with an actionbutton OR when the session opens.
I've tryed the below code using session$clientData but it doesn't work.
Also tried to play with toggleModal from shinyBS but still no chance. Any help much appreciated. Thanks!
library(shiny)
ui <- fluidPage(
actionButton("go", "Go"),
numericInput("n", "n", 50),
plotOutput("plot")
)
server <- function(session, input, output) {
randomVals <- eventReactive({input$go
session$clientData}, {
runif(input$n)
})
output$plot <- renderPlot({
hist(randomVals())
})
}
shinyApp(ui, server)
Actually figured this out. On my question above, I tried to simplified my code, and doing so actually fixed the issue...
randomVals <- eventReactive({input$go
session$clientData}
works as expected (i.e. you get a chart when opening the session even without clicking on go), while
randomVals <- eventReactive({session$clientData
input$go}
doesn't work (i.e you need to click on go to get your first chart
So I guess the order in the event {} matters, which I didn't know

R Shiny: Is there a way to check if a button is disabled using shinyjs package?

Is there a way to check if a download button is disabled using the shinyjs R package? I want to use shinyjs or something similar because they have very easy syntax. This is my package:
server.R:
library(shiny)
library(shinyjs)
library(shinyBS)
shinyServer(function(input, output) {
observe({
shinyjs::disable("download1")
if(shinyjs::is.disabled("download1")){ ## This is what I am trying to do
# Do something
}
})
})
ui.R
shinyUI(fluidPage(
downloadButton("download1")
))
Not directly (well, not easily*).
Buttons can only be disabled when you decide to disable them, so you can have some sort of a reactive variable that holds whether or not the button should be disabled, and whenever you disable the button, you also change the value of that variable. In order to make sure they stay in sync, every time you want to disable the button you can set the variable to mirror that, and then you can use shinyjs::toggleState(condition = variable) so that the disabled state will mirror what the variable says.
Example code to illustrate what I mean:
library(shiny)
ui <- fluidPage(
shinyjs::useShinyjs(),
numericInput("num", "When divisible by 3, disable the button", 1),
actionButton("btn", "button")
)
server <- function(input, output, session) {
values <- reactiveValues(disable = FALSE)
observe({
values$disable <- (input$num %% 3 == 0)
})
observe({
shinyjs::toggleState("btn", condition = !values$disable)
})
}
shinyApp(ui = ui, server = server)
In this app, whenever you want to disable the button, simply set values$disable to FALSE and to enable the button set it to TRUE. To check if the button is currently on or off at any point in time, you can look at the value of values$disable.
*I'm guessing that you wanted a more direct approach to ask the app a question in real time "hey shiny, is button X currently disabled?". You can do that, but it would involve writing custom javascript code to check for the button state, and for custom code to ask javascript that question and to listen for its response. This would work and be guaranteed to be correct, but it's likely overkill for most cases.

With selectizeInput, stop the list of choices from closing after each selection

I am trying to include a selectizeInput widget in a Shiny app. However, one aspect of its behavior is problematic: each time I make a selection, the box containing the choices closes.
I took a look at the example app here: http://shiny.rstudio.com/gallery/selectize-examples.html. Specifically, input number 2: Multi-select. The selection window remains open in this example, yet I see no differences between that code and mine which would account for the variance in behavior.
For the sake of a reproducible example, I have put together the following code:
ui <- fluidPage(uiOutput("example"))
server <- function(input, output, session){
output$example <- renderUI({
selectizeInput(
inputId="people",
label=NULL,
choices=paste("A", 1:50, sep="_"),
multiple = TRUE,
selected=input$people
)
})
} # close server
shinyApp(ui = ui, server=server)
My guess is that I'm missing something obvious, so here's a chance for an easy answer for someone that knows their way around Shiny. Any help will be greatly appreciated.
When you remove the selected=input$people line, it works as intended.

Resources