Enable Action Button if Input has changed - r

My app should follow this logic: If an action button is pressed, all inputs are disabled and a long computation is performed. When the computation is finished and its results are plotted, all inputs except for the action button become enabled again. If the user decides to change one input, the action button becomes enabled.
Most of this desired behaviour is working, except for the last bit, the enabling of the action button. Here is my server function (the action button is named "go"):
server <- function(input, output, session) {
allinputIds <- reactive(names(input))
shiny::observeEvent(input$go, {
for (id in allinputIds()) shinyjs::disable(id)
})
# ==> here is some trouble: not working
shiny::observeEvent(allinputIds(), shinyjs::enable("go"))
# from here starts the real work
bins <- shiny::eventReactive(input$go, {
x <- faithful$waiting
Sys.sleep(1.5)
seq(min(x), max(x), length.out = input$bins + 1)
})
output$figure <- shiny::renderPlot({
x <- faithful$waiting
hist(
x, breaks = bins(), col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
for (id in setdiff(allinputIds(), "go")) shinyjs::enable(id)
})
}
How can I observe that any input has been changed? Instead of allinputIds() after the line marked "==>", I tried input but this worked neither.
As a second question, what would you recommend to encapsulate this button / disable / enable pattern, which I plan to use on more than one shiny module. It would be nice if I could concentrate on the main code, i.e. bins and output$figure <- ....
Any hint appreciated!
For reproducibility, here is the ui function:
ui <- shiny::tagList(
shinyjs::useShinyjs(),
shiny::navbarPage(title="Test 2",
tabPanel(title="Old Faithful",
shiny::sidebarLayout(
shiny::sidebarPanel(
shiny::sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
shiny::mainPanel(
shiny::actionButton("go", "Update"),
shinycssloaders::withSpinner(plotOutput(outputId="figure")),
shiny::h4(shiny::textOutput("msg"))
)
)
)
)
)
shiny::shinyApp(ui, server)

The problem is that in shiny::observeEvent(allinputIds(), shinyjs::enable("go")) you just check if the names/amount of input ids change - they don't. You actually need to check if the values of any of the inputs (besides the action button) has changed. Therefore you can either put all inputs directly into the observe like c(input$bins, input$...) or make an extra reactive to check for the values and just call this reactive.
library(shiny)
server <- function(input, output, session) {
allinputIds <- reactive(names(input))
changingInputValues <- reactive({
checkIds <- setdiff(names(input), "go")
lapply(checkIds, function(x) input[[x]])
})
observeEvent(input$go, {
lapply(allinputIds(), shinyjs::disable)
})
# ==> here is some trouble: not working
observeEvent(changingInputValues(), shinyjs::enable("go"))
# from here starts the real work
bins <- eventReactive(input$go, {
x <- faithful$waiting
Sys.sleep(1.5)
seq(min(x), max(x), length.out = input$bins + 1)
})
output$figure <- renderPlot({
x <- faithful$waiting
hist(
x, breaks = bins(), col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
lapply(setdiff(allinputIds(), "go"), shinyjs::enable)
})
}
ui <- tagList(
shinyjs::useShinyjs(),
navbarPage(title="Test 2",
tabPanel(title="Old Faithful",
sidebarLayout(
sidebarPanel(
sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
mainPanel(
actionButton("go", "Update"),
shinycssloaders::withSpinner(plotOutput(outputId="figure")),
h4(textOutput("msg"))
)
)
)
)
)
shinyApp(ui, server)
Note that I've changed the for loops to lapply, as for loops tend to not work well with shiny (unfortunately, I'm not sure why). A few times the enabling of the inputs didn't work when using the loop, but with lapply I haven't had any problems.

Related

Using input from a dynamically created input in shiny

I am trying to create a dynamic UI that has variable number of user inputs based on a user input and charts that uses that second level of user input.
A working example below:
library(shiny)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
numericInput(inputId = "Chartcount",
label = "Enter number of charts",
value = 5,
min = 2,
max = 8),
uiOutput("distui")
)
server <- function(input, output) {
c_count = reactive({input$Chartcount})
output$distui <- renderUI({
lapply(seq(1:c_count()), function(x){
chartId = (paste("Chart",x, sep = "="))
sinput <- sliderInput(inputId = paste(x,"_bins"),
"Number of bins:",
min = 1,
max = 50,
value = 30)
selectedbins = input[[paste(x,"_bins")]] # input$inputId does not work here as expression after $ can not be evaluated
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = 25 ) #I want to use selectedbins here for length.out
distplot <- renderPlot(hist(x, breaks = bins, col = 'darkgray', border = 'white'))
list(chartId, sinput,selectedbins, distplot)
})
})
}
shinyApp(ui = ui, server = server)
I think there are at least a couple of problems with this.
Selected number of bins resets as soon as they are selected
I get an error when I try to use selectedbins in the chart for
length.out
bins <- seq(min(x), max(x), length.out = selectedbins ) # This throws an error Error: argument 'length.out' must be of length 1
The selected number of bins is resetting because it is inside of the same reactive expression, you should put it in a different reactive expression, otherwise the full expression is going to be executed every time you change the input and it is going to recreate all the inputs and plots.
The second problem is caused because you are trying to use the selectedbins input value before the slider is created, therefore the value is NULL (length 0), you can only get the value after the slider is created.
Below is your code modified to create the plots in a separated reactive expression as a nested expression, maybe not the best solution but it is in the same style that your program. Also, reusing the x variable is confusing, so I changed the first one by k.
library(shiny)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
numericInput(inputId = "Chartcount",
label = "Enter number of charts",
value = 5,
min = 2,
max = 8),
uiOutput("distui")
)
server <- function(input, output) {
output$distui <- renderUI({
lapply(seq(1:input$Chartcount), function(k){
chartId = (paste("Chart", k, sep = "="))
sinput <- sliderInput(inputId = paste(k, "bins_"),
"Number of bins:",
min = 1,
max = 50,
value = 30)
x <- faithful[, 2]
distplot <- tagList(
renderUI({
selectedbins = input[[paste(k, "bins_")]]
bins <- seq(min(x), max(x), length.out = selectedbins )
tagList(
selectedbins,
renderPlot(hist(x, breaks = bins, col = 'darkgray', border = 'white'))
)
})
)
list(chartId, sinput, distplot)
})
})
}
shinyApp(ui = ui, server = server)

observeEvent is triggered unnecessary when using one evenExpr for mulitple handlerExpr in Shiny

Im creating shiny app. for calculating risk score where the user will upload input file and select the input such as ethnic groups, type of calculating score and diseases. After all of the input are selected and file is uploaded, my App. will be run when user click at action button and the output such as graph and dataframe will be shown
Im using observeEvent to control my App for triggering unnecessarily( mulitple handleExpr with one eventExpr), and this is my shorten version of code. Im sorry for my code that is not reproducible.
observeEvent(input$action,{
isolate(system2("bash_script/plink.sh",args = c(input$file$datapath,input$type,input$sum_stat,input$Disease,input$Ethnic,input$Ref)))
output$table_score <- renderDataTable({
percentile <- read.csv("../output/score_percentile.csv",header = T, sep = "\t")
}, selection = "single")
output$table_variant <- renderDataTable({
varaints_in_sample <- fread("../output/summary.csv", header = T, drop = 1)
})
#Plot Graph
output$plot <- renderPlot({
s <- input$table_score_cell_clicked
plot("../output/score_percentile_plot.csv",s,"analysis")
})
})
my problem is that when Im running app for the first time, everything is controllable. However, if I want to select new input. for example im changing input disease from heart disease to another disease. my App. will be triggered unnecessarily although I did NOT click at action button.
So, Is there any way to use observeEvent with one evenExpr for mulitple handleExpr
Thanks everyone for your help!
I think, this is simplified example of your problem. The solution is to put all your input$... inside isolate().
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton('action', 'Click')
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
req(input$action)
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = isolate(input$bins) + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui = ui, server = server)

shiny modules: Store parameters (additional argument) already when creating module-UI instead of passing it to module's server function?

I have created a module sliderCheckbox which bundles together a sliderInput and a checkBoxInput to disable the sliderInput - basically a possibility to state "I don't know", which is necessary for survey-like inputs. When the slider is disabled, I want it to return a default value - most often the initial value, but not necessarily.
Now my question is: Is there any possibility to pass this default value when initialising the UI, that is with sliderCheckboxInput()? As the default value is a property like minimum and maximum, that is where it logically belongs to, and it also fits better to the rest of my setup.
Example:
library(shiny)
library(shinyjs)
sliderCheckboxInput <- function(id,description="",
min = 0,
max = 100,
value = 30,
default= NULL ##HERE I would want the default value to be set
cb_title = "I don't know"){
ns <- NS(id)
fluidRow(
column(width=9,
sliderInput(ns("sl"),
paste0(description, collapse=""),
min = min,
max = max,
value = value)
),
column(width=2,
checkboxInput(ns("active"),
cb_title, value=FALSE )
)
)
}
sliderCheckbox<- function(input, output, session,
default=NA) { #Problem: set default when initialising module
oldvalue<- reactiveVal()
observeEvent(input$active, {
if (input$active){
oldvalue(input$sl)
disable("sl")
updateSliderInput(session, "sl", value=default)
}else {
updateSliderInput(session, "sl", value=oldvalue())
enable("sl")
}
toggleState("sl", !input$active)
})
onclick("sl",
if(input$active) updateCheckboxInput(session, "active", value=FALSE)
)
return ( reactive({
if (input$active){
default
}else {
input$sl
}
}))
}
ui <- fluidPage(
useShinyjs(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderCheckboxInput("bins", "Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
bins_nr <- callModule(sliderCheckbox, "bins", default=44)
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = bins_nr() + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui, server)
You can send the value from the ui to the server using a hidden textInput
library(shiny)
library(shinyjs)
sendValueToServer <- function(id, value) {
hidden(textInput(
id, "If you can see this, you forgot useShinyjs()", value
))
}
myModuleUI <- function(id, param) {
ns <- NS(id)
tagList(
sendValueToServer(ns("param_id"), param),
textOutput(ns("text_out"))
)
}
myModule <- function(input, output, session) {
param <- isolate(input$param_id)
output$text_out <- renderText({
param
})
}
shinyApp(
ui = fluidPage(
useShinyjs(),
myModuleUI("id", "test")
),
server = function(input, output, session) {
callModule(myModule, "id")
}
)
There are probably more direct ways to do this using the JavaScript API of shiny but this is a "pure R" solution which should be enough for most usecases. Note that you can use the input value at initialization time with
isolate(input$text_in)
because the ui is always built before the server. Things get more complicated if everything is wrapped into renderUI but this does not seem to be the case for you.
Somewhat late to the party, but I think a neater way to do this is to use session$userData. This is available to both the main server function and the module's sewrver function.
So, in the main server, before callModule creates the module server:
session$userData[["module_id"]]$defaultValue <- myDefaultValue
and then at the end of module server function:
return ( reactive({
if (input$active){
session$userData[["module_id"]]$defaultValue
} else {
input$sl
}
})
)
That strikes me as neater, more robust and more generic than using a hidden input.

ShinyApp with dynamic text appearing on any change across a number of UI elements

I'm interested in developing a Shiny App that would act in the following manner:
Update the chart following any changes to the number of user interface elements. This done through the actionButton / isolate construct.
Display a warning text prompting user to click the Update button. Outstanding.
Remove the warning text after the Update button was pressed. Outstanding.
Example
Approach
Drawing from one of the examples available via rstudio the following example provides access to two functionalities that modify the histogram.
Histogram is updated upon the Update button click.
Upon interaction with the UI the observeEvent construct should update the warning message that is then passed to renderText.
If there is no interaction with the UI the renderText can return empty string.
actionButton should revert warning message string value to empty c(""). Alternative approach making use from insertUI / renderUI is acceptable.
Code
app.R
library(shiny)
ui <- fluidPage(titlePanel("Reactive UI"),
sidebarLayout(
sidebarPanel(
# Reactive text should appear upon any change here
sliderInput(
"bins",
"Number of bins:",
min = 1,
max = 50,
value = 30
),
checkboxInput(
inputId = "chckBxLg",
label = "Log scale",
value = FALSE
)
,
actionButton("btnUpdate", "Update")
),
mainPanel(textOutput("msgTxt"),
plotOutput("distPlot"))
))
# Define server logic required to draw a histogram
server <- function(input, output) {
# Create placeholder object for msg
msgUpdateText <- c("")
# Insert update message text upon change to UI elements
observeEvent(eventExpr = {
input$bins
input$chckBxLg
},
handlerExpr = {
# This message should only show after interaction with the UI
isolate(msgUpdateText <<-
c("You have clicked something, update the chart"))
})
# Render text
output$msgTxt <- renderText(msgUpdateText)
output$distPlot <- renderPlot({
input$btnUpdate
isolate({
x <- faithful[, 2]
if (input$chckBxLg) {
x <- log(x)
}
bins <-
seq(min(x), max(x), length.out = input$bins + 1)
# Also delete the text message
msgUpdateText <<- c("")
})
hist(x,
breaks = bins,
col = 'darkgray',
border = 'white')
})
}
shinyApp(ui = ui, server = server)
Problem
The message:
You have clicked something, update the chart
should only appear only after user interacts with the UI and disappear after the actionButton is pressed, instead the message is visible permanently.
Side notes
The offered solution should be extensible across a number of UI, elements. The provided, not-working, example attempts to capture change to two UI elements:
observeEvent(eventExpr = {
input$bins # Element 1
input$chckBxLg # Element 2
},
handlerExpr = {
# This message should only show after interaction with the UI
isolate(msgUpdateText <<-
c("You have clicked something, update the chart"))
})
I'm striving for the code to accommodate a vast number of elements, on the lines
observeEvent(eventExpr = {
input$bins # Element 1
input$chckBxLg # Element 2
input$title # Element 3
input$n # Element n
... ...
},
handlerExpr = {
# User interacted with any of the UI elements listed above
# Update text message to be displayed in the app
})
I think I've managed to achieve the desired result. I've brought the necessarily logic into 3 observeEvent calls. The first observes any of the inputs changing and sets a variable to TRUE. The second observes the updatebutton and sets the variable to FALSE. The third observe both the inputs and the updatebutton and renders the warning message based on the variable (if it's TRUE it prints, otherwise it's empty).
The only problem I've found is that at the moment it starts off showing the warning message, but I haven't been able to figure out why.
The final code:
library(shiny)
ui <- fluidPage(titlePanel("Reactive UI"),
sidebarLayout(
sidebarPanel(
# Reactive text should appear upon any change here
sliderInput(
"bins",
"Number of bins:",
min = 1,
max = 50,
value = 30
),
checkboxInput(
inputId = "chckBxLg",
label = "Log scale",
value = FALSE
)
,
actionButton("btnUpdate", "Update")
),
mainPanel(uiOutput("msgui"),
plotOutput("distPlot"))
))
# Define server logic required to draw a histogram
server <- function(input, output) {
# Initialize the value to check if a change happened
Changebool <<- FALSE
observeEvent(eventExpr = { #When an input is changed
input$bins
input$chckBxLg
},
handlerExpr = { # Change the changebool to TRUE
Changebool <<- TRUE
}
)
observeEvent(eventExpr = { #When the update button is pressed
input$btnUpdate
},
handlerExpr = { # Change the changebool to FALSE
Changebool <<- FALSE
}
)
observeEvent({input$btnUpdate # If any of the inputs change or the update button is pressed
input$bins
input$chckBxLg},
{ # Recreate the message-ui
output$msgui <- renderUI({
if (Changebool) { # if a change has happened since last update
textOutput("msgTxt") #Output text
} else { #otherwise
#Output nothing
}
})
})
# Render text
output$msgTxt <- renderText("You have clicked something, update the chart")
output$distPlot <- renderPlot({
input$btnUpdate
isolate({
x <- faithful[, 2]
if (input$chckBxLg) {
x <- log(x)
}
bins <-
seq(min(x), max(x), length.out = input$bins + 1)
})
hist(x,
breaks = bins,
col = 'darkgray',
border = 'white')
})
}
shinyApp(ui = ui, server = server)
I must admit I was fiddling back and forth with this for quite a bit so if you notice anything weird in the code feel free to drop a comment

How do I make sure that a shiny reactive plot only changes once all other reactives finish changing?

I have a shiny app in which the user selects a bunch of inputs, such as the x range, y range, types of scaling and the selection of a particular subset of the data set through a drop down list.
This is all done through the use of reactives. X and Y range slider inputs react to changes in the selection of the data set because the minimum and maximum have to be found again. This takes maybe about 1-2 seconds while the shiny app is working and the user chooses a different option in the drop down list. During those 1-2 seconds, the plot switches to plotting the selected new subset of data with the old x and y range before quickly switching to the correct plot once the x and y range sliders change.
A fix would be to just refresh the plot on a button by isolating everything else. But would there be a way to keep the plot reactive to changes, but just wait until all the dependent things have finished calculating?
Thanks
This is the plot:
output$plot1 <- rCharts::renderChart2({
if(!is.null(input$date_of_interest) &&
!is.null(input$xrange) &&
!is.null(input$yrange) &&
!is.null(data()) &&
isolate(valid_date_of_interest())) {
filtered_data<- dplyr::filter(isolate(data()), id==input$choice)
p <- tryCatch(plot_high_chart(
data,
first_date_of_interest = input$date_of_interest,
ylim = input$yrange,
xlim = input$xrange),
error = function(e) e,
warning = function(w) w)
if(!inherits(p, "error") && !inherits(p, "warning")) {
return(p)
}
}
return(rCharts::Highcharts$new())
})
and x range(y range is similar):
output$xrange <- renderUI({
if(!is.null(input$date_of_interest) &&
!is.null(input$choice) &&
!is.null(valid_date_of_interest()) &&
isolate(valid_date_of_interest())) {
temp_data <- dplyr::filter(isolate(data()), date == input$date_of_interest)
temp <- data.table::data.table(temp_data, key = "child.id")
the_days <- as.double(as.Date(temp$last.tradeable.dt) - as.Date(temp$date))
min_days <- min(the_days,na.rm=TRUE)
max_days <- max(the_days,na.rm=TRUE)
sliderInput("xrange",
"Days Range (X Axis)",
step = 1,
min = 0,
max = max_days + 10,
value = c(min_days,max_days)
)
}
})
and the input choice:
output$choice<- renderUI({
selectInput("choice",
"Choose:",
unique(data$id),
selected = 1
)
})
Some direction and suggestions to implement would be useful. I've thought about having global variables such as x_range_updated, y_range_updated, that are set to false in the code for output$choice and then set to true in the code for output$xrange, etc. And then have plot1 depend on them being true. Other suggestions to approach this problem would be appreciated.
Edit 2019-02-14
Since Shiny 1.0.0 (released after I originally wrote this answer), there is now a debounce function which adds functionality to help with this kind of task. For the most part, this avoids the need for the code I originally wrote, although under the hood it works in a similar manner. However, as far as I can tell, debounce doesn't offer any way of short-circuiting the delay with a redraw action button along the lines of what I'd done here. I've therefore created a modified version of debounce that offers this functionality:
library(shiny)
library(magrittr)
# Redefined in global namespace since it's not exported from shiny
`%OR%` <- shiny:::`%OR%`
debounce_sc <- function(r, millis, priority = 100, domain = getDefaultReactiveDomain(), short_circuit = NULL)
{
force(r)
force(millis)
if (!is.function(millis)) {
origMillis <- millis
millis <- function() origMillis
}
v <- reactiveValues(trigger = NULL, when = NULL)
firstRun <- TRUE
observe({
r()
if (firstRun) {
firstRun <<- FALSE
return()
}
v$when <- Sys.time() + millis()/1000
}, label = "debounce tracker", domain = domain, priority = priority)
# New code here to short circuit the timer when the short_circuit reactive
# triggers
if (inherits(short_circuit, "reactive")) {
observe({
short_circuit()
v$when <- Sys.time()
}, label = "debounce short circuit", domain = domain, priority = priority)
}
# New code ends
observe({
if (is.null(v$when))
return()
now <- Sys.time()
if (now >= v$when) {
v$trigger <- isolate(v$trigger %OR% 0) %% 999999999 +
1
v$when <- NULL
}
else {
invalidateLater((v$when - now) * 1000)
}
}, label = "debounce timer", domain = domain, priority = priority)
er <- eventReactive(v$trigger, {
r()
}, label = "debounce result", ignoreNULL = FALSE, domain = domain)
primer <- observe({
primer$destroy()
er()
}, label = "debounce primer", domain = domain, priority = priority)
er
}
This then permits a simplified shiny application. I've switched to the single file mode of working, but the UI remains the same as the original one.
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
selectInput("column", "Column", colnames(faithful), selected = "waiting"),
actionButton("redraw", "Redraw")
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
reac <- reactive(list(bins = input$bins, column = input$column)) %>%
debounce_sc(5000, short_circuit = reactive(input$redraw))
# Only triggered by the debounced reactive
output$distPlot <- renderPlot({
x <- faithful[, reac()$column]
bins <- seq(min(x), max(x), length.out = reac()$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white',
main = sprintf("Histogram of %s", reac()$column))
})
}
shinyApp(ui, server)
Original version (pre Shiny 1.0.0)
You haven't provided a reproducible example, so I've gone with something based on the Shiny faithful example that is the default in RStudio. The solution I've got will always have a (configurable) 5 second delay between an input changing and the graph being redrawn. Each change in input resets the timer. There's also a redraw button for the impatient which redraws the graph immediately. The values of the reactive value 'redraw' and the inputs are shown in the console every time an input changes or the timer ticks. This should be removed for production use. Hopefully this meets your needs!
library(shiny)
shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
selectInput("column", "Column", colnames(faithful), selected = "waiting"),
actionButton("redraw", "Redraw")
),
mainPanel(
plotOutput("distPlot")
)
)
))
server.R
library(shiny)
shinyServer(function(input, output, session) {
reac <- reactiveValues(redraw = TRUE, bins = isolate(input$bins), column = isolate(input$column))
# If any inputs are changed, set the redraw parameter to FALSE
observe({
input$bins
input$column
reac$redraw <- FALSE
})
# This event will also fire for any inputs, but will also fire for
# a timer and with the 'redraw now' button.
# The net effect is that when an input is changed, a 5 second timer
# is started. This will be reset any time that a further input is
# changed. If it is allowed to lapse (or if the button is pressed)
# then the inputs are copied into the reactiveValues which in turn
# trigger the plot to be redrawn.
observe({
invalidateLater(5000, session)
input$bins
input$column
input$redraw
isolate(cat(reac$redraw, input$bins, input$column, "\n"))
if (isolate(reac$redraw)) {
reac$bins <- input$bins
reac$column <- input$column
} else {
isolate(reac$redraw <- TRUE)
}
})
# Only triggered when the copies of the inputs in reac are updated
# by the code above
output$distPlot <- renderPlot({
x <- faithful[, reac$column]
bins <- seq(min(x), max(x), length.out = reac$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white',
main = sprintf("Histogram of %s", reac$column))
})
})

Resources