I have the following code in server.R:
library(shiny)
source("helpers.R")
shinyServer(function(input, output) {
output$txtOutput1 <- renderText({
someLengthyComputation(input$txtInput)[1]
})
output$txtOutput2 <- renderText({
someLengthyComputation(input$txtInput)[2]
})
output$txtOutput3 <- renderText({
someLengthyComputation(input$txtInput)[3]
})
})
helpers.R contains the method someLengthyComputation which returns a vector of size 3. How can I get around calling it three times every time txtInput changes and only call it once while updating all three text output controls?
You can simply place someLengthyComputation inside a reactive expression:
shinyServer(function(input, output) {
someExpensiveValue <- reactive({
someLengthyComputation(input$txtInput)
})
output$txtOutput1 <- renderText({
someExpensiveValue()[1]
})
output$txtOutput2 <- renderText({
someExpensiveValue()[2]
})
output$txtOutput3 <- renderText({
someExpensiveValue()[3]
})
})
someLengthyComputation will be triggered only when input$txtInput changes and the first of the outputs is rendered otherwise someExpensiveValue will return a cached value.
It is also possible, although execution strategy is a little bit different, to use a combination of reactiveValues and observe.
If someLengthyComputation is really expensive you should consider adding an action button or a submit button and triggering the computations only when it is clicked, especially when you use textInput.
Related
In my Shiny application, I'd like the click of a button to dynamically populate a list of new buttons. Each of these buttons should act specifically and uniquely.
So far I have been able to get the "main" button to create the list of buttons. I have not been able to figure out how to get each of the individual buttons to act accordingly. For simplicity, let's say that I'd like to print the label of the button. In reality, each button triggers should trigger a a variety of things and set a number of reactive values, but that's outside the scope for now.
Here is a reproducible example. In particular, only the last button receives an event listener. And when it fires, it for some reason fires N times; in this example N = 5. In reality too, the buttons may disappear on another event, but then should show up again if that "main" button was clicked a second time.
library(shiny)
ui <- pageWithSidebar(headerPanel("test"),
sidebarPanel(actionButton("build", "Build")),
mainPanel(uiOutput("buttons")))
server <- function(input, output) {
observeEvent(input$build, {
output$buttons <- renderUI({
btns <- list()
for (ix in 1:5) {
name <- paste("btn_", ix)
btns <- c(btns,
list(actionButton(
name, paste("Button", ix)
)))
observeEvent(input[[name]], {
print(name)
})
}
btns
})
})
}
shinyApp(ui, server)
What do I need to do in order to have an event listener associated with each button?
I have tried a variety of things, including wrapping the observeEvent() in local({}), creating a new button name with the namespace like ns <- NS(name) and ns(name) after, and moving renderUI outside of the parent observeEvent().
I've taken a look at Shiny - Can dynamically generated buttons act as trigger for an event, How to create dynamic number of observeEvent in shiny?, and Dynamic number of actionButtons tied to unique observeEvent, among others, but either I didn't understand them or they weren't quite right.
Bonus points if you can explain what's happening behind the scenes so I can learn more about Shiny reactivity!
Created on 2021-12-01 by the reprex package (v2.0.1)
Here is a sample app using purrr from the tidyverse that work very good to create multiple inputs. I also added textOutput's to see that the buttons are being clicked. This app could be further modified to select the amount of buttons to create.
App::
library(shiny)
number_of_buttons <- 5
outputs <- map(paste0('btn_', seq(1:number_of_buttons)), ~textOutput(outputId = .))
ui <- pageWithSidebar(headerPanel("test"),
sidebarPanel(actionButton("build", "Build")),
mainPanel(uiOutput("buttons"),
tagList(outputs)))
# server ------------------------------------------------------------------
server <- function(input, output) {
observeEvent(input$build, {
#this creates a list with five buttons to pass into `renderUI`
buttns_inputs <-
paste0('btn_', seq(1:number_of_buttons)) %>%
map(~ actionButton(., .))
output$buttons <- renderUI({
tagList(buttns_inputs)
})
})
#for debugging purposes
observe({
req(input$btn_1)
names(input) %>%
str_subset('^btn') %>%
walk(~ {output[[.]] <<- renderPrint({input[[.]] %>% print}) })
})
}
shinyApp(ui, server)
Simplified version:
library(shiny)
number_of_buttons <- 5
ui <- pageWithSidebar(
headerPanel("test"),
sidebarPanel(actionButton("build", "Build")),
mainPanel(uiOutput("buttons"))
)
# server ------------------------------------------------------------------
server <- function(input, output) {
observeEvent(input$build, {
# this creates a list with five buttons to pass into `renderUI`
buttns_inputs <-
paste0("btn_", seq(1:number_of_buttons)) %>%
map(~ actionButton(., .))
output$buttons <- renderUI({
tagList(buttns_inputs)
})
})
}
shinyApp(ui, server)
I have a simple shiny app where the user should input comma-separated values into a text input, chose the output and click on a button to convert to an output.
I have followed the advice in Update content on server only after I click action button in Shiny to change the output only when clicking, and it works.
However, only when starting/ opening the app the first time, the field is empty, yet the output seems to try to evaluate the input field.
It is more of a cosmetic problem, because once the user filled something in, this does not recur, but I wonder how I could avoid this...
My app:
library(shiny)
ui <- fluidPage(
textInput("from", "csv", value = NULL),
actionButton("run", "Run"),
textOutput("to")
)
server <- function(input, output, session) {
list1 <- reactive({
input$run
x <- isolate(paste(read.table(text = input$from, sep = ",")))
x
})
output$to <- renderText({
list1()
})
}
shinyApp(ui = ui, server = server)
The not-desired output - I would like to get rid of the errors.
you can use req(input$from), see Check for required values
I'm trying to debug my shiny dashboard
For several render* function, I need to debug them with some log (with print or cat) but I can't use those function inside a renderDataTable() / renderText()
for example:
output$selectedData = renderDataTable(
myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]
)
I would like to print something to the console before and after the instruction of renderDataTable() but
output$selectedData = renderDataTable(
cat("rendering...")
myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]
cat("rendered")
)
How can I do this ?
Here is a possible solution to the problem. First I use a variable called data to assingn any calculations to, in your case
data<-myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]. This is used inside the render function and will be created when the output is rendered since it relies on this. I then use an observe function that requires the variable data to be created before printing the second "rendered" to the console. That works once on startup, and will work fine if your data is constant. If you have changing data, for my example the data changes with a user selection, we will have to re-render the table. Since the render function is reactive and you are using input$process_tokens, the render function will re-run when the input changes. In this example it runs when input$select changes. When it runs it resets the variable data to NULL, and we trigger a separate observeEvent that monitors changes to input$select(input$process_tokens). This observeEvent also requires data before continuing, and since the render function set it to null it will not print the second "rendered" until data is created, just as in the first case.
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput("select","select",choices=(c(1,2,3,4)))
),
mainPanel(
dataTableOutput("selectedData")
)
))
server <- function(input, output, session) {
data<-reactive({data.frame(input$select,4,5)})
output$selectedData <- renderDataTable({
data<-NULL
print("rendering..")
data<-datatable(data())
})
#Observe inital rendering (only needed if no change to data)
observe({
req(data)
print("rendered!")
})
#Observe Changes to data
observeEvent(input$select,{
req(data)
print("rendered!")
})
}
shinyApp(ui, server)
Specific code for you:
server <- function(input, output, session) {
output$selectedData <- renderDataTable({
data<-NULL
print("rendering..")
data<- myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]
})
#Observe inital rendering (only needed if no change to data)
observe({
req(data)
print("rendered!")
})
#Observe Changes to data
observeEvent(input$process_tokens,{
req(data)
print("rendered!")
})
}
shinyApp(ui, server)
Note that you will get two "rendered" printouts when the program initially starts, this is b/c both the observe and observeEvent run since both conditions are met. If your data does change with input$process_tokens, then you can get rid of the observe function, and only use the observeEvent. If your data does not change and the table is only rendered once, then get rid of the observeEvent. I was trying to cover all bases.
Let's say we have a set of widgets each with their own input label. How do we create a reactive object whose value is the character that represents the input ID of the last widget that was modified?
For example, if we have
ui.R
shinyUI(fluidPage(
textInput('txt_a', 'Input Text A'),
textInput('txt_b', 'Input Text B")
))
server.R
shinyServer(function(input, output) {
last_updated_widget <- reactive({
#hypothetical code that indicates ID value of last updated widget
})
})
The desired result is as follows. If the user modifies the first text box, then the value of last_updated_widget() would be "txt_a". If they modify the second box, the value of last_updated_widget() becomes "txt_b". I'm in search of a result that extends to the obvious generalization of setting the value to be the ID of any of the widgets that was adjusted last.
I'd like this to work for an arbitrary number of widget inputs, including the case that they were generated by a renderUI() statement. So making a separate reactive() statement for each widget isn't an option. However, if the reactive statement requires a loop over all the widget names (or something like that) I can certainly work with that. And multiple reactive statements is okay, as long as it's a fixed amount, and not a function of the number of widgets.
It seems like a pretty simple problem, so I was surprised when it became a roadblock for me. I feel like the solution would be really obvious and I'm just not seeing, so if it is, I apologize for making it a new question. But any help would be greatly appreciated.
Here's a solution that works, though it looks a little awkward because of a nested observe(). I'm not sure what a better way would be, but there could be something nicer.
Basically, use an observe() to loop over all the available inputs, and for each input, use another observe() that will only trigger when that input is changed and set a variable to the id of the input.
runApp(shinyApp(
ui = shinyUI(
fluidPage(
textInput('txt_a', 'Input Text A'),
textInput('txt_b', 'Input Text B'),
uiOutput('txt_c_out'),
verbatimTextOutput("show_last")
)
),
server = function(input, output, session) {
output$txt_c_out <- renderUI({
textInput('txt_c', 'Input Text C')
})
values <- reactiveValues(
lastUpdated = NULL
)
observe({
lapply(names(input), function(x) {
observe({
input[[x]]
values$lastUpdated <- x
})
})
})
output$show_last <- renderPrint({
values$lastUpdated
})
}
))
You can use a reactive value created with reactiveValues() to store the name of the last used widget. Later use an observer to keep track of the activity of each widget and update the reactive value with the name of the last used widget.
In the folowing example, the name of the last used widget is stored in last_updated_widget$v and will active the verbatimTextOutput each time it changes. You can use last_updated_widget$v at any place in the server.
library(shiny)
runApp(list(
ui = shinyUI(
fluidPage(
textInput('txt_a', 'Input Text A'),
textInput('txt_b', 'Input Text B'),
verbatimTextOutput("showLast")
)
),
server = function(input, output, session) {
last_updated_widget <- reactiveValues( v = NULL)
observe ({
input$txt_a
last_updated_widget$v <- "txt_a"
})
observe ({
input$txt_b
last_updated_widget$v <- "txt_b"
})
output$showLast <- renderPrint({
last_updated_widget$v
})
}
))
I am running into an issue because observe is being called first before the UI loads.
Here is my ui.R
sidebarPanel(
selectInput("Desk", "Desk:" , as.matrix(getDesksUI())),
uiOutput("choose_Product"), #this is dynamically created UI
uiOutput("choose_File1"), #this is dynamically created UI
uiOutput("choose_Term1"), #this is dynamically created UI ....
Here is my Server.R
shinyServer(function(input, output,session) {
#this is dynamic UI
output$choose_Product <- renderUI({
selectInput("Product", "Product:", as.list(getProductUI(input$Desk)))
})
#this is dynamic UI
output$choose_File1 <- renderUI({
selectInput("File1", "File 1:", as.list(getFileUI(input$Desk, input$Product)))
})
#this is dynamic UI and I want it to run before the Observe function so the call
# to getTerm1UI(input$Desk, input$Product, input$File1) has non-null parameters
output$choose_Term1 <- renderUI({
print("Rendering UI for TERM")
print(paste(input$Desk," ", input$Product, " ", input$File1,sep=""))
selectInput("Term1", "Term:", getTerm1UI(input$Desk, input$Product, input$File1))
})
This is my observe function and it runs before the input$Product and input$File1 are populated so I get an error because they are both NULL. But I need to use the input from the UI.
observe({
print("in observe")
print(input$Product)
max_plots<-length(getTerm2UI(input$Desk, input$Product, input$File1))
#max_plots<-5
# Call renderPlot for each one. Plots are only actually generated when they
# are visible on the web page.
for (i in 1:max_plots ) {
# Need local so that each item gets its own number. Without it, the value
# of i in the renderPlot() will be the same across all instances, because
# of when the expression is evaluated.
local({
my_i <- i
plotname <- paste("plot", my_i, sep="")
output[[plotname]] <- renderPlot({
plot(1:my_i, 1:my_i,
xlim = c(1, max_plots ),
ylim = c(1, max_plots ),
main = paste("1:", my_i, ". n is ", input$n, sep = "") )
})
})
}##### End FoR Loop
},priority = -1000)
Any idea how to get the input$Product and input$File1 to be populated BEFORE observe runs?
Thank you.
EDIT: Scroll down to TClavelle's answer for a better solution. While this answer has the most upvotes, I wrote it when Shiny had fewer features than it does today.
The simplest way is to add an is.null(input$Product) check at the top of each observe, to prevent it from running before the inputs it uses are initialized.
If you don't want your observers to do the null-check each time they're run, you can also use the suspended = TRUE argument when registering them to prevent them from running; then write a separate observer that performs the check, and when it finds that all inputs are non-null, calls resume() on the suspended observers and suspends itself.
You need to use the Shiny Event Handler and use observeEvent instead of observe. It seems to be about the only way to get rid of the "Unhandled error" message caused by NULL values on app startup. This is so because unlike observe the event handler ignores NULL values by default.
So your observe function could end up looking something like this (no need for priorities, or resume/suspended etc!)
observeEvent(input$Product, ({
max_plots<-length(getTerm2UI(input$Desk, input$Product, input$File1))
... (etc)
})# end of the function to be executed whenever input$Product changes
)
I could not copy paste your example code easily to make it run, so I'm not entirely sure what your full observe function would look like.
You can use req() to "require" an input before a reactive expression executes, as per the Shiny documentation here: https://shiny.rstudio.com/articles/req.html and the function documentation here: https://shiny.rstudio.com/reference/shiny/latest/req.html
e.g.
observeEvent({
req(input$Product)
req(input$File1)
# ...
})
We'd need an MRE to provide a working answer, but, assuming you need input$Product and input$File1, but do not want to take a dependency on them, only on input$Desk, you could:
observe({
product <- isolate(input$Product)
file1 <- isolate(input$File1)
print("in observe")
print(product)
max_plots<-length(getTerm2UI(input$Desk, product, file1))
for (i in 1:max_plots ) {
# ...
}
})
this is probably effectively equivalent to an observeEvent(input$Desk, ....), but might offer more flexibility.