I have configuration options for a shiny app that are behind a panel. Moreover, the configuration options are generated server side using uiOutput/renderUI.
Shiny defers evaluation of items that are not in the currently selected panel, but sometimes it's desirable to force evaluation. Is it possible to force server side evaluation?
Here's an example:
library(shiny)
ui <- fluidPage(
tabsetPanel(tabPanel("Main",
plotOutput("dots")),
tabPanel("Settings",
uiOutput("even.or.odd")
)
)
)
server <- function(input, output) {
output$dots <- renderPlot({
plot(seq(ifelse(input$even, 0, 1), 20, 2))
})
output$even.or.odd <- renderUI(checkboxInput('even', "Even?",TRUE))
}
shinyApp(ui = ui, server = server)
Or from RStudio do runGist('https://gist.github.com/dkulp2/d897c21dfd1a20f9531b6454ea02a533')
This fails on startup because input$even is undefined until the "Settings" panel is revealed. (And then the app works fine.) Is there some way to cause Shiny to evaluate the even.or.odd function without revealing the panel?
You can force execution of hidden output objects by setting suspendWhenHidden = FALSE with outputOptions
outputOptions(output, "even.or.odd", suspendWhenHidden = FALSE)
Related
I need to use Javascript shiny events (e.g. shiny:recalculated) described here https://shiny.rstudio.com/articles/js-events.html to know when to trigger next frontend test action (without sleeps). This makes tests deterministic and reduces testing time.
However, I cannot use the event from Cypress nor from slave browser developer console.
Consider e.g. simple code taken from https://github.com/rstudio/shiny-examples/blob/master/084-single-file/app.R and modified to run app in browser
# Global variables can go here
n <- 200
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
plotOutput('plot')
)
# Define the server code
server <- function(input, output) {
output$plot <- renderPlot({
hist(runif(input$n))
})
}
# Return a Shiny app object
shinyApp(ui = ui, server = server, options = list(launch.browser = TRUE))
After executing
$(document).on('shiny:recalculated', function (event) {
if (event.target.id === "plot") {
alert('Output has been just refreshed')
}
})
in browser developer console and modifying input (to 201) I get
However, that's not the case in case of browser runned by Cypress. Any ideas why?
Having following simple application:
library("shiny")
ui <- fluidPage(
uiOutput('model'),
textInput('search', 'Look for a model')
)
server <- function(input, output, session) {
options <- c('a', 'b', 'c', 'd')
output$model <- renderUI({
checkboxGroupInput("model",
"Select a model:",
options,
selected='a')
})
observeEvent(input$search,{
updateCheckboxGroupInput(session,"model",
"Select a model:",
options[grep(input$search, options)])
})
}
shinyApp(ui = ui, server = server)
I want to display choices to the user with a already preselected. Later, I would like to update the CheckboxGroupInput only after user starts typing into a search box . However, the checkbox seems to be updated immediately and the preselected choice a is not displayed.
Why does the observeEvent does not wait for interaction with the inputText? Any ideas how I could fix this and wait until user starts typing (I don't want to use button)?
Prevent execution of observe on app load in Shiny provides the answer. The observeEvent will just not be executed on start.
EDIT: (to make answer explicit as #lbusett suggested)
Setting ignoreInit = TRUE in the call to observeEvent solves the problem.
I am making an app with drag and drop feature using the ShinyDND package. I would like to pass a list from input as a parameter of dragSetUI, a function that needs to be run in ui.R. I tried renderUI and uiOutput, and it almost works, but the dragged elements fail to be dropped in the drop area. As you can see in the example below, nonreactive choices work like charm. I tried creating a reactive object as well as text output, but I could not find documentation on how to refer to these objects in ui.R. Normally one would refer to output$x as "x" in Output, but here, if I add anything between quotes, it reads as string. I am really stuck with this.
library(shiny)
library(shinyDND)
nonreactive_choices<-as.list(c("a","b","c"))
ui <- shinyUI(
mainPanel(
textInput("choices","Put here a,b,c:"),
dragSetUI("drag", textval = "reactive_choices"),
dragSetUI("drag", textval = "choice_rv"),
textOutput("reactive_choices"),
dragSetUI("drag", textval = nonreactive_choices),
dropUI("drop")
)
)
server = shinyServer(function(input, output,session) {
output$reactive_choices<-reactive({
strsplit(input$choices,",")
})
observe({
chlist<-strsplit(input$choices,",")
choice_rv<-reactiveVal(chlist)
})
})
# Run the application
shinyApp(ui = ui, server = server)
Let's see why the renderUI approach does not work with shinyDND. An app using shinyDND is linked to the dragndrop.js file, which is in the shinyDND folder. In this file one can see:
$(document).ready(function(){
......
$(".dragelement").on("dragstart",function(e){
e.originalEvent.dataTransfer.setData("Text",e.target.id);
});
......
});
This defines the action to perform on elements having class dragelement when a drag is starting, and this is defined when the document is ready. dragSetUI creates such elements.
When you use a dragSetUI inside a renderUI, this creates new elements of class dragelement. But the action defined on such elements in $(document).ready is not effective for these new elements, because this action has been defined just after the document is ready, and then before the effect of renderUI.
A solution consists in defining the action of the event dragstart inside the renderUI. This works:
library(shiny)
library(shinyDND)
nonreactive_choices<-as.list(c("a","b","c"))
ui <- shinyUI(
mainPanel(
textInput("choices","Put here d,e,f:"),
dragSetUI("drag", textval = nonreactive_choices),
uiOutput("dragset"),
dropUI("drop")
)
)
server = shinyServer(function(input, output,session) {
reactive_choices <- reactive({
strsplit(input$choices,",")[[1]]
})
output$dragset <- renderUI({
tagList(
dragSetUI("drag2", textval = as.list(reactive_choices())),
tags$script('$(".dragelement").on("dragstart",function(e){
e.originalEvent.dataTransfer.setData("Text",e.target.id);
});'
)
)
})
})
# Run the application
shinyApp(ui = ui, server = server)
Comment by #ismirsehregal helped me find the solution: shinyjqui can be used for my purposes and it seems to work from inside renderUI. Here is the edited code that does exactly what I needed.
library(shiny)
library(shinyjqui)
ui <- fluidPage(
textInput("choices","Put here a,b,c:"),
uiOutput("reactiveselect"),
orderInput(inputId = 'drop', label = 'Reactive drop', items = NULL,placeholder = "drop here..."),
verbatimTextOutput("droppedorder")
)
server <- function(input, output) {
output$reactiveselect <- renderUI({
req(input$choices)
reactiveitems<- unlist(strsplit(input$choices,","))
orderInput("groupstochoose", "groups to choose from:", connect='drop',items=reactiveitems)
})
output$droppedorder<-
renderPrint({input$drop_order})
}
shinyApp(ui, server)
I am trying to make Shiny App which allows users to save inputs and later load them.
Easiest way to approach this, is to make Save button, which saves inputs. Here is basic app to demonstrate:
server.R
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("integer", "Integer:",
min = 0, max = 1000,
value = 500)
),
mainPanel(tableOutput("values"),
actionButton('save_inputs', 'Save inputs')
)
))
server <- function(input, output, session) {
sliderValues <- reactive({
value = input$integer
})
output$values <- renderTable({
sliderValues()
})
observeEvent(input$save_inputs,{
saveRDS( input$integer , file = 'integer.RDS')
})
}
shinyApp(ui = ui, server = server)
However, I would like to make saving automatic, e.g. I want inputs to be saved at end of session. onSessionEnded() should be answer to this, but it can't reach input values and save them.
session$onSessionEnded( function() {
saveRDS( input$integer, file = 'integer.RDS')
})
Which returns error: Warning:
Error in .getReactiveEnvironment()$currentContext: Operation not
allowed without an active reactive context. (You tried to do something
that can only be done from inside a reactive expression or observer.)
Is there any way to solve it?
Using isolate seems to solve the problem.
session$onSessionEnded(function() {
isolate(saveRDS( input$integer, file = 'integer.RDS'))
})
Using another observe event function and watching the value of isClosed() we can
make this work
observeEvent(session$isClosed()==T,{
saveRDS( input$integer, file = 'integer.RDS')
})
observeEvent() as well as reactive() are both considered "reactive" environments which means they are watching for changing values throughout the session and not just on startup. If you put a function that needs to be reactive outside of a reactive environment shiny will do you the favor of sending you that error, to inform you the function would never be called unless we wrap it in a reactive function.
Also +1 for the well composed question.
In the following example, the text is not shown in the start. If I click on the "show"-Button the text appears. If I then click on the "hide"-Button nothing else happens anymore.
In fact the "textis$visible" variable has always the correct value, but i think the if-statement in the observeEvent funktion is only calculated after the very first button click.
Is there a way to force observeEvent to re-evaluate the if statement? Or are there other ways to stop shiny from executing code in the server part and restart it again (in the real case there would be a whole bunch of function calls inside the if statement, not just hide and show some text)
library(shiny)
ui <- fluidPage(
actionButton(inputId="show","show"),
actionButton(inputId="hide","hide"),
textOutput(outputId = "some_text")
)
server <- function(input, output) {
textis<-reactiveValues(visible=FALSE)
observeEvent(input$show,
textis$visible<-TRUE)
observeEvent(input$hide,
textis$visible<-FALSE)
observeEvent(textis$visible , if(textis$visible){
output$some_text<-renderText({"this is some text"})
})}
shinyApp(ui = ui, server = server)
The observeEvent expressions are evaluated any time the value of their event expression changes. But, in the code you have above, when textis$visible changes, the observer only has instructions to perform if textis$visible is true. In the code snippet below, I've used else{...} to give that observer an action to perform when testis$visible is not true.
observeEvent(textis$visible , if(textis$visible){
output$some_text<-renderText({"this is some text"})
} else {output$some_text<-renderText({''}) }
)}
So, if you paste the else clause above into your app, the output some_text will disappear when the hide button is clicked.
It is not very good practice to put a render element in an observer (and it is unnecessary). Also since you have only one reactiveValue, you could use reactiveVal(), see the example below. You can call its value with text_visible(), and update it with text_visible(new_value).
Working example:
library(shiny)
ui <- fluidPage(
actionButton(inputId="show","show"),
actionButton(inputId="hide","hide"),
textOutput(outputId = "some_text")
)
server <- function(input, output) {
text_visible<-reactiveVal(TRUE)
observeEvent(input$show,
text_visible(TRUE))
observeEvent(input$hide,
text_visible(FALSE))
output$some_text<-renderText({
if(text_visible())
return("this is some text")
else
return("")
})
}
shinyApp(ui = ui, server = server)
try something like this:
library(shiny)
ui <- fluidPage(
actionButton(inputId="show","show"),
actionButton(inputId="hide","hide"),
textOutput(outputId = "some_text")
)
server <- function(input, output) {
textis <- reactiveVal(F)
observeEvent(input$show,{textis(T)})
observeEvent(input$hide,{textis(F)})
result <- eventReactive(textis(),{
if(!textis()){
return()
}
"this is some text"
})
output$some_text<-renderText({result()})
}
shinyApp(ui = ui, server = server)