Conditional reactivity Shiny - r

Reactive expressions in Shiny propagate changes where they need to go. We can suppress some of this behaviour with isolate, but can we suppress changes being propagated based on our own logical expression?
The example I give is a simple scatterplot, and we draw a crosshair with abline where the user clicks. Unfortunately, Shiny considers the result to be a new plot, and our click value is reset to NULL... which in turn is treated as an update to the value to be propagated as usual. The plot is redrawn, and NULL is passed to both arguments of abline.
My hack (commented out below) is to place a condition in the renderPlot call which updates some non-reactive variables for the plotting coordinates, only when the click values are non-NULL. This works fine for trivial plots, but it actually results in the plot being drawn twice.
What's a better way to do this? Is there a correct way?
Server file:
library(shiny)
shinyServer(function (input, output)
{
xclick <- yclick <- NULL
output$plot <- renderPlot({
#if (!is.null(input$click$x)){
xclick <<- input$click$x
yclick <<- input$click$y
#}
plot(1, 1)
abline(v = xclick, h = yclick)
})
})
UI file:
library(shiny)
shinyUI(
basicPage(
plotOutput("plot", click = "click", height = "400px", width = "400px")
)
)

Winston calls this problem "state" accumulation - you want to display not only the current data, but something generated by the previous plot (the best place to learn about this is at https://www.rstudio.com/resources/videos/coordinated-multiple-views-linked-brushing/)
The basic idea is to create your own set of reactive values, and update them when the user clicks on the plot. They won't be invalidated until the next click, so you don't get circular behaviour.
library(shiny)
shinyApp(
shinyUI(basicPage(plotOutput("plot", click = "click"))),
function(input, output) {
click <- reactiveValues(x = NULL, y = NULL)
observeEvent(input$click, {
click$x <- input$click$x
click$y <- input$click$y
})
output$plot <- renderPlot({
plot(1, 1)
abline(v = click$x, h = click$y)
})
}
)

Related

How to drag a plot line and back into the resulting line parameters in R Shiny?

Here's a long-shot question. The below code allows the user to build and alter a scaled-logarithmic curve by altering its 4 parameters, via slider inputs. I'd like to reverse the process, so the user clicks/drags the plot line and a new "exponential" curve parameter is backed into. How to do this in R Shiny?
Later, after figuring out how to derive the exponential parameter, I'll try backing into some of the other curve parameters too.
This image illustrates what I'm trying to do:
Code:
library(shiny)
ui <- fluidPage(
sliderInput('periods','Nbr of periods:',min=0,max=36,value=24),
sliderInput('start','Start value:',min=0,max=1,value=0.15),
sliderInput('end','End value:',min=0,max=1,value=0.70),
sliderInput('exponential','Exponential:',min=-100,max=100,value=10),
plotOutput('plot')
)
server <- function(input, output, session) {
data <- reactive({
data.frame(
Periods = c(0:input$periods),
ScaledLog = c(
(input$start-input$end) *
(exp(-input$exponential/100*(0:input$periods))-
exp(-input$exponential/100*input$periods)*(0:input$periods)/input$periods)) +
input$end
)
})
output$plot <- renderPlot(plot(data(),type='l',col='blue',lwd=5))
}
shinyApp(ui,server)

Hover tooltip in Shiny using pure ggplot2 solution

The goal here is to render a tooltip on hover using a pure ggplot2 solution without any plotly of javascript hacks.
Here is a naive tentative solution (that does not work)
library(tidyverse)
library(shiny)
shinyApp(
ui = fluidPage(
plotOutput("plotCars", hover="hover", width=700,height=300),
verbatimTextOutput("info")),
server = function(input, output) {
hovered <- reactive(nearPoints(mtcars, input$hover, maxpoints = 1) %>%
rownames_to_column("model"))
output$plotCars <- renderPlot({
ggplot(mtcars, aes(x=wt, y=mpg)) +
geom_point() +
geom_point(color="red",data=hovered()) +
geom_label(aes(label=model),data=hovered(),
hjust="inward",vjust="inward",
size=4,color="red",alpha=0.5)+
xlab("Weight(1000 lbs)")+ylab("Miles/gallon")
})
output$info <- renderPrint({
hovered()
})
})
The problem here is that as soon as the plot is re-rendered including the hover information (e.g. a label), the hover event is automatically reset to NULL, thus invalidating the plot.
In practice the above solution almost works, the tooltip for the hovered point is briefly shown, but immediately the input$hover event is invalidated by the new plot and the re-rendering of the plot removed the tooltip since a that point the hover event is now NULL. In fact the tooltip blinks once and then disappears.
The solution is to keep the previous value of the hovered data point avoiding the invalidation. This objective can be achieved using the observeEvent() method and a reactiveVal(). The solution works like this:
the hovered point information is a reactive value (reactiveVal()), initialized with a zero-row tibble with the same columns as the plotted data set.
This initial value allow a smooth visualization in a ggplot2 layer, that would not be possible initializing it to NULL.
the value is updated in response to an hover event, the function observeEvent() by default ignores when an event become NULL (ignoreNULL = TRUE), therefore when the input$hover is invalidated to NULL the value is not updated and remain the same as before
in the plot rendering, the hovered() value is initially a zero-row tibble (but still having the right columns to be compatible with the plot default data) thus not showing anything, later when an hover near a point is performed it will contain the point information.
library(tidyverse)
library(shiny)
shinyApp(
ui = fluidPage(
plotOutput("plotCars", hover="hover", width=700,height=300),
verbatimTextOutput("info")),
server = function(input, output) {
hovered <- reactiveVal(mtcars %>% filter(FALSE) %>% rownames_to_column("model"))
observeEvent(input$hover, {
hovered(nearPoints(mtcars, input$hover, maxpoints = 1) %>%
rownames_to_column("model"))
})
output$plotCars <- renderPlot({
ggplot(mtcars, aes(x=wt, y=mpg)) +
geom_point() +
geom_point(color="red",data=hovered()) +
geom_label(aes(label=model),data=hovered(),
hjust="inward",vjust="inward",
size=4,color="red",alpha=0.5)+
xlab("Weight(1000 lbs)")+ylab("Miles/gallon")
})
output$info <- renderPrint({
hovered()
})
})

How to fix "object 'mydata' not found" in shiny app when plotting histogram

I'm trying to create a Shiny app that lets users
create a dataset by entering frequency counts for different values
plot a histogram of that dataset
A paired back example of the code is as follows:
library(shiny)
library(ggplot2)
# Define UI for application
ui <- fluidPage(
# Sidebar with inputs
sidebarLayout(
sidebarPanel(
numericInput("data1s",
"How many have a score of 1?",
value = 0,
min = 0
),
numericInput("data2s",
"How many have a score of 2?",
value = 0,
min = 0
),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 3,
value = 1)
),
# Show a plot of the data
mainPanel(
htmlOutput("mydatatable"),
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
#show the data
output$mydatatable <- renderTable({
#create the dataframe from the frequncies
mydata <- data.frame(our_data=c(rep(1,input$data1s),rep(2,input$data2s))
)
}
)
#show the histogram
output$distPlot <- renderPlot({
ggplot(mydata, aes(x=our_data)) +
geom_histogram(bins = input$bins)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have achieved the creation of the dataset, but the code for displaying a histogram of the data returns an error: "object 'mydata' not found" instead of showing the histogram. The histogram should update whenever any of the inputs are changed.
Any help to resolve would be much appreciated.
The mydata that you define in the mydatatable reactive is not visible anywhere else. To understand why, I suggest you read about R's namespaces and environments; one good tutorial on it is Hadley's Advanced R -- Environments.
To fix it, I suggest you make the data itself a reactive block, and depend on it in your two other blocks (table and plot):
server <- function(input, output) {
mydata <- reactive({
req(input$data1s, input$data2s)
data.frame(our_data=c(rep(1,input$data1s),rep(2,input$data2s)))
})
#show the data
output$mydatatable <- renderTable({ req(mydata()); })
#show the histogram
output$distPlot <- renderPlot({
req(mydata())
ggplot(mydata(), aes(x=our_data)) +
geom_histogram(bins = input$bins)
})
}
(Untested.)
I added the use of req solely to prevent start-up jittering and warnings/errors in the app. When the shiny app is warming up, it's common to have input variables empty (NULL), and things that depend on it will temporarily produce errors until the inputs stabilize. (For an example of why things will stumble, input$data1s may initially show a NULL value, and try to see if data.frame(our_data=rep(1,NULL)) will work.)
req just looks for something that is "truthy", meaning: not NULL, not NA, not FALSE, length greater than 0, etc. See ?shiny::req for more details.
While req is not strictly required, it has its advantages. As you may infer from the table code, req(x) will return the "first value that was passed in" (from ?req), so it can be used in this shortcut mode for brevity.
And one last soap-box: in my limited experience with shiny reactivity, there are few times that I've generated data within a reactive block and used it solely within that reactive block. Given that, whenever you make a data.frame (or list or ... some important structure that is dependent on user input), it is often beneficial to make it its own reactive component (specifically, not an output component), and then depend on it as many times as necessary.

R Shiny: How to temporarily disable reactivity?

I am building a UI containing DT tables and sliders (both as inputs), as well as plot outputs. The tables are used to make a selection out of several. The user can only select one cell to make a choice.
I want the user to be able to store the setting of tables and sliders because they are quite complex. The idea is that the user can then switch back and forth between two stored settings, for example, and see how the resulting plots change. When a user restores a setting, the tables and sliders get updated, which updates the plot(s).
The problem is that the plot is not updated once, but usually twice. It seems that there is a delay somewhere in the logic, causing Shiny to first react to the update of the sliders, then to the update of the tables, so that the plot is re-plotted in two steps. This is very annoying for two reasons: (1) it causes the calculation to re-run twice, making the app react twice as slow and (2) it's impossible to see the changes directly in the plot because the original plot is first replaced by an intermediate plot which has no meaning to the user.
To illustrate the problem, I created this minimum working example, where I reduced complexity to just one table and one slider. I added a 3 second Sys.sleep to simulate a long calculation because obviously one would not see the problem otherwise:
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button", "Preset"),
# No problem with selectInput:
# selectInput("select", "x", choices = names(iris)[1:4], selected = "Sepal.Length"),
DT::dataTableOutput("table"),
sliderInput("slider", "bins", min = 1, max = 50, value = 30)
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
observeEvent(input$button, {
# updateSelectInput(session, "select", selected = "Petal.Width")
selectRows(DT::dataTableProxy("table"), 4)
updateSliderInput(session, "slider", value = 15)
})
output$table <- DT::renderDataTable(
DT::datatable(
data.frame(x = names(iris)[1:4]),
rownames = FALSE,
selection = "single",
options = list(searching = FALSE, paging = FALSE, info = FALSE, ordering = FALSE)
)
)
output$distPlot <- renderPlot({
req(input$table_rows_selected)
# x <- iris[[input$select]]
x <- iris[[input$table_rows_selected]]
bins <- seq(min(x), max(x), length.out = input$slider + 1)
# Simulate long calculation:
Sys.sleep(3)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui = ui, server = server)
Clicking first on the cell "Sepal.Length" in the table, then on the button "Preset" will load the preset and demonstrate the problem.
It seems that this is a timing issue/race condition, because sometimes, it works OK and the plot is updated only once (only in the minimal example, not the actual app). Usually the first time after starting the app. But in that case, just click on "Sepal.Length" again and change the slider position, then click on the "Preset" button and usually the plot will update twice.
I noticed that the problem does not appear when I replace the table with a selectInput. But the tables have a certain meaning: they stand for morphological fields (see package morphr), so I'd rather stick with tables to have the right appearance.
I could obviuously also disable reactivity using isolate() as suggested here: R Shiny: how to prevent duplicate plot update with nested selectors? and then e.g. introduce a button "Update plot". But I would prefer to keep the app reactive to changes in the sliders and tables, because that's a very useful user experience and one reason for me to use Shiny instead of PHP/python/etc.
My first idea to solve the problem was to introduce a reactive value:
server <- function(input, output, session) {
updating <- reactiveVal(FALSE)
# ...
}
then change the value before and after the updates to the inputs:
observeEvent(input$button, {
updating(TRUE)
selectRows(DT::dataTableProxy("table"), 4)
updateSliderInput(session, "slider", value = 15)
updating(FALSE)
})
and add an if statement in the renderPlot() code, e.g. with validate:
output$distPlot <- renderPlot({
validate(need(!updating(), ""))
# ...
})
But that has no effect, because the entire code in the observeEvent(input$button) runs first, setting updating to TRUE and immediately back to FALSE. But the code inside renderPlot() is executed later (after the invalidation has occurred) and updating is always FALSE when it runs.
So, at the moment I have few ideas how to solve this. It would be best if one could somehow disable reactivity for the plot, then update the inputs, enable reactivity again and trigger a plot update programmatically. But is this possible?
Any other ideas for a workaround?
I'm not sure to understand the issue. Does this solve the problem:
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
......
observeEvent(input$button, {
runjs("Shiny.setInputValue('slider', 15); Shiny.setInputValue('table_rows_selected', 4);")
selectRows(DT::dataTableProxy("table"), 4)
updateSliderInput(session, "slider", value = 15)
})

Shiny Interactive Graph plot showing row names

I am using Shiny and ggplot2 for an interactive graph. I also used "plot1_click" to get x and y locations.
output$selected <- renderText({
paste0("Value=", input$plot1_click$x, "\n",
"Names=", input$plot1_click$y) }) #how to get names???
This is part of server code. Here what I want is, instead of printing the "y" coordinates, I want to print the corresponding name written in y-axis. Is there any possible way for it??
As far as I know clicking points is not supported in plotOutput. Click events will only return coordinates of the click location. Those coordinates can however be used to figure out the nearest point.
This shiny app from the shiny gallery pages uses the function shiny::nearPoints which does exactly that. Here is a minimal example.
library(shiny)
library(ggplot2)
shinyApp(
fluidPage(
plotOutput("plot", click = "plot_click"),
verbatimTextOutput('print')
),
server = function(input, output, session){
output$plot <- renderPlot({ggplot(mtcars, aes(wt, mpg)) + geom_point()})
output$print = renderPrint({
nearPoints(
mtcars, # the plotting data
input$plot_click, # input variable to get the x/y coordinates from
maxpoints = 1, # only show the single nearest point
threshold = 1000 # basically a search radius. set this big enough
# to show at least one point per click
)
})
}
)
The verbatimTextOutput shows you the nearest point to the clicked location. Notice that nearPoints only works with ggplots like that. But the help page suggests that there is also a way to use this with base graphics.

Resources