I'm familiar with the basics of shiny but struggling with something here. I would like to be able to add a ggplot layer when a point is clicked to highlight that point. I know this is possible with ggvis and there is a nice example in the gallery, but I would like to be able to use nearPoints() to capture the click as ui input.
I have tried something (see below) which works apart from the ggplot layer appears and then disappears. I have tried all kinds of edits to this with reactive(), eventReactive() and so on.
Any help is much appreciated...
library(shiny)
library(ggplot2)
shinyApp(
ui = shinyUI(
plotOutput("plot", click = "clicked")
),
server = shinyServer(function(input, output) {
output$plot <- renderPlot({
ggplot(mtcars, aes(x = mpg, y = wt)) +
geom_point() +
geom_point(data = nearPoints(mtcars, input$clicked), colour = "red", size = 5)
})
})
)
I think I understand conceptually why this doesn't work. The plot has a dependency on input$clicked which means that when input$clicked changes the plot re-renders but this in turn resets input$clicked. Bit of a catch 22 situation.
Please, try this:
Approach 1 (recommended)
library(shiny)
library(ggplot2)
# initialize global variable to record selected (clicked) rows
selected_points <- mtcars[0, ]
str(selected_points)
shinyApp(
ui = shinyUI(
plotOutput("plot", click = "clicked")
),
server = shinyServer(function(input, output) {
selected <- reactive({
# add clicked
selected_points <<- rbind(selected_points, nearPoints(mtcars, input$clicked))
# remove _all_ duplicates if any (toggle mode)
# http://stackoverflow.com/a/13763299/3817004
selected_points <<-
selected_points[!(duplicated(selected_points) |
duplicated(selected_points, fromLast = TRUE)), ]
str(selected_points)
return(selected_points)
})
output$plot <- renderPlot({
ggplot(mtcars, aes(x = mpg, y = wt)) +
geom_point() +
geom_point(data = selected(), colour = "red", size = 5)
})
})
)
If you click a point one time it is highlighted. If you click it a second time the highlight is turned off again (toggling).
The code uses a global variable selected_points to store the actually highlighted (selected) points and an reactive expression selected() which updates the global variable whenever a point is clicked.
The str(selected_points) may help to visualize the working but can be removed.
Approach 2 (alternative)
There is a slightly different approach which uses observe() instead of reactive() and references the global variable selected_points directly instead of returning the object from a function:
library(shiny)
library(ggplot2)
selected_points <- mtcars[0, ]
str(selected_points)
shinyApp(
ui = shinyUI(
plotOutput("plot", click = "clicked")
),
server = shinyServer(function(input, output) {
observe({
# add clicked
selected_points <<- rbind(selected_points, nearPoints(mtcars, input$clicked))
# remove _all_ duplicates (toggle)
# http://stackoverflow.com/a/13763299/3817004
selected_points <<-
selected_points[!(duplicated(selected_points) |
duplicated(selected_points, fromLast = TRUE)), ]
str(selected_points)
})
output$plot <- renderPlot({
# next statement is required for reactivity
input$clicked
ggplot(mtcars, aes(x = mpg, y = wt)) +
geom_point() +
geom_point(data = selected_points, colour = "red", size = 5)
})
})
)
Of course, you can use the global variable selected_points directly in the ggplot call instead of calling the reactive function selected(). However, you have to ensure that renderPlot() is executed whenever input$clicked is changed. Therefore, the dummy reference to input$clicked has to be included in the code within renderPlot().
Now, the reactive function selected() is no longer needed and can be replaced by an observe() expression. As opposed to reactive(), observe() doesn't return a value. It just updates the global variable selected_points whenever input$clicked is modified.
Approach 3 (reactive values)
This approach avoids a global variable. Instead, it uses reactiveValues to create a list-like object rvwith special capabilities for reactive programming (see ?reactiveValues).
library(shiny)
library(ggplot2)
shinyApp(
ui = shinyUI(
plotOutput("plot", click = "clicked")
),
server = shinyServer(function(input, output) {
rv <- reactiveValues(selected_points = mtcars[0, ])
observe({
# add clicked
rv$selected_points <- rbind(isolate(rv$selected_points),
nearPoints(mtcars, input$clicked))
# remove _all_ duplicates (toggle)
# http://stackoverflow.com/a/13763299/3817004
rv$selected_points <- isolate(
rv$selected_points[!(duplicated(rv$selected_points) |
duplicated(rv$selected_points, fromLast = TRUE)), ])
str(rv$selected_points)
})
output$plot <- renderPlot({
ggplot(mtcars, aes(x = mpg, y = wt)) +
geom_point() +
geom_point(data = rv$selected_points, colour = "red", size = 5)
})
})
)
Please, note that in the observer part references to rv need to be encapsulated in isolate() to ensure that only changes to input$clicked will trigger execution of the code in observer. Otherwise, we'll get an endless loop. Execution of renderPlot is triggered whenever the reactive value rv is changed.
Conclusion
Personally, I prefer approach 1 using reactive functions which make the dependencies (reactivity) more explicit. I find the dummy call to input$clicked in approach 2 less intuitive. Approach 3 requires a thorough understanding of reactivity and using isolate() in the right places.
Related
I wasted hours to find out why my plot is automatically updating itself when I change inputs while it was supposed to wait for the Run button but it simply ignored that step and I ended up finally finding ggplot as the trouble maker!!! This is my minimal code:
library(ggplot2)
library(tidyverse)
varnames <- names(cars)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
column(
width = 12,
# Variables Inputs:
varSelectInput("variables", "Select Input Variables", cars, multiple = TRUE),
selectizeInput("outvar", "Select Output Variable", choices = varnames, "speed", multiple = F),
# Run Button
actionButton(inputId = "run", label = "Run")
)
)
),
# Main panel for displaying outputs ----
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
df <- reactive({
cars %>% dplyr::select(!!!input$variables, input$outvar)
})
plt <- eventReactive(input$run, {
#Just creating lm formula
current_formula <- paste0(input$outvar, " ~ ", paste0(input$variables, collapse = " + "))
current_formula <- as.formula(current_formula)
#Fitting lm
fit <- lm(current_formula, data = df())
pred <- predict(fit, newdata = df())
#Plotting
ggplot(df(), aes(df()[, input$outvar], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
#plot(df()[, input$outvar], pred) #This one works fine!!!!
})
output$plot <- renderPlot({
plt()
})
}
# Run the application
shinyApp(ui = ui, server = server)
If you run this, you'll notice that ggplot doesn't care anymore about the Run button after the 1st run and it keeps updating as you change the inputs!! However, if you use the simple base plot function (which I put in a comment in the code) there wouldn't be any problems and that works just fine! Sadly I need ggplot in my app because base plot is ugly. I am seeing suggestion for using isolate() to solve this issue but I have no clue where isolate() should be put to fix my problem also it doesn't make sense to use isolate() when base plot function works fine without it and it's the ggplot that makes the problem. Any explanation would be appreciated.
The issue is that ggplot aesthetics are lazy evaluated. You really want to put symbols into the aes() rather that reactive data values. Change your plotting code to
ggplot(df(), aes(.data[[input$outvar]], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
With ggplot you use the .data pronoun to access the current data source rather than trigger the reactive df() object again.
Consider a simple plotly scatterplot that is dependent on a user selection (via selectInput) that selects the variable to plot on a particular axis. We want to update the plot with the click of a button, rather than when the user interacts with the selectInput. So, we wrap the plot-update logic in an observeEvent that takes a dependency on the button. The observeEvent updates a reactiveValues object that contains the plot. (This example uses reactiveValues because we're demonstrating this with both ggplot and plotly plots.)
When the app is run, before clicking the actionButton, changing the selected variable from selectInput does not update the plot (as expected). However, after the actionButton has been clicked once, any further change to the selectInput invalidates the plotly plot instantly and causes it to re-render. This behaviour does not occur with the ggplot plot (which only updates when the actionButton is clicked).
I've also tried wrapping the reactive value that defines the plotly plot in isolate, and create an explicit dependency on the input$update_plts button, but that makes no difference.
library(shiny)
library(ggplot2)
library(plotly)
ui <- {
fluidPage(
selectInput('select_xvar', label = 'select x var', choices = names(mtcars)),
actionButton('update_plts', 'Update plots'),
plotOutput('plt1'),
plotlyOutput('plt2')
)
}
server <- function(input, output, session) {
val <- reactiveValues(
plt1 = ggplot(mtcars) +
geom_point(aes(x = wt, y = mpg)
),
plt2 = plot_ly(mtcars,
x = ~wt,
y = ~mpg
)
)
observeEvent(input$update_plts, {
val$plt1 = ggplot(mtcars) +
geom_point(aes_string(
x = input$select_xvar,
y = 'mpg'
))
val$plt2 = plot_ly(mtcars,
x = ~get(input$select_xvar),
y = ~mpg)
})
output$plt1 <- renderPlot(val$plt1)
# initial attempt with no isolate
# output$pl2 <- renderPlotly(val$plt2)
# second attempt with isolate, still invalidates instantaneously
output$plt2 <- renderPlotly({
input$update_plts
isolate(val$plt2)
})
}
shinyApp(ui, server)
Any ideas why this is the case with plotly? The only reference to this I could find is a closed Github issue that is apparently unresolved.
R version 3.6.0
plotly version 4.9.2.1
shiny version 1.5.0
Not sure why, but it works as expected when you isolate inputs in the plot_ly call:
val$plt2 = plot_ly(mtcars,
x = ~get(isolate(input$select_xvar)),
y = ~mpg)
You can then remove isolate and actionButton from renderPlotly:
output$plt2 <- renderPlotly(val$plt2)
I am setting up a small shiny app where I do not want the plot to change unless the action button is clicked. In the example below, when I first run the app, there is no plot until I click the action button. However, if I then change my menu option in the drop-down from Histogram to Scatter, the scatter plot is automatically displayed even though the value for input$show_plot has not changed because the action button has not been clicked.
Is there a way that I can change my menu selection from Histogram to Scatter, but NOT have the plot change until I click the action button? I've read through several different posts and articles and can't seem to get this worked out.
Thanks for any input!
ui.R
library(shiny)
fluidPage(
tabsetPanel(
tabPanel("Main",
headerPanel(""),
sidebarPanel(
selectInput('plot_type', 'Select plot type', c('Histogram','Scatter'), width = "250px"),
actionButton('show_plot',"Plot", width = "125px"),
width = 2
),
mainPanel(
conditionalPanel(
"input.plot_type == 'Histogram'",
plotOutput('plot_histogram')
),
conditionalPanel(
"input.plot_type == 'Scatter'",
plotOutput('plot_scatter')
)
))
)
)
server.R
library(shiny)
library(ggplot2)
set.seed(10)
function(input, output, session) {
### GENERATE SOME DATA ###
source_data <- reactive({
mydata1 = as.data.frame(rnorm(n = 100))
mydata2 = as.data.frame(rnorm(n = 100))
mydata = cbind(mydata1, mydata2)
colnames(mydata) <- c("value1","value2")
return(mydata)
})
# get a subset of the data for the histogram
hist_data <- reactive({
data_sub = as.data.frame(source_data()[sample(1:nrow(source_data()), 75), "value1"])
colnames(data_sub) <- "value1"
return(data_sub)
})
# get a subset of the data for the scatter plot
scatter_data <- reactive({
data_sub = as.data.frame(source_data()[sample(1:nrow(source_data()), 75),])
return(data_sub)
})
### MAKE SOME PLOTS ###
observeEvent(input$show_plot,{
output$plot_histogram <- renderPlot({
isolate({
plot_data = hist_data()
print(head(plot_data))
p = ggplot(plot_data, aes(x = value1, y = ..count..)) + geom_histogram()
return(p)
})
})
})
observeEvent(input$show_plot,{
output$plot_scatter <- renderPlot({
isolate({
plot_data = scatter_data()
print(head(plot_data))
p = ggplot(plot_data, aes(x = value1, y = value2)) + geom_point()
return(p)
})
})
})
}
Based on your desired behavior I don't see a need for actionButton() at all. If you want to change plots based on user input then the combo of selectinput() and conditionPanel() already does that for you.
On another note, it is not good practice to have output bindings inside any reactives. Here's an improved version of your server code. I think you are good enough to see notice the changes but comment if you have any questions. -
function(input, output, session) {
### GENERATE SOME DATA ###
source_data <- data.frame(value1 = rnorm(n = 100), value2 = rnorm(n = 100))
# get a subset of the data for the histogram
hist_data <- reactive({
# reactive is not needed if no user input is used for creating this data
source_data[sample(1:nrow(source_data), 75), "value1", drop = F]
})
# get a subset of the data for the histogram
scatter_data <- reactive({
# reactive is not needed if no user input is used for creating this data
source_data[sample(1:nrow(source_data), 75), , drop = F]
})
### MAKE SOME PLOTS ###
output$plot_histogram <- renderPlot({
req(hist_data())
print(head(hist_data()))
p = ggplot(hist_data(), aes(x = value1, y = ..count..)) + geom_histogram()
return(p)
})
output$plot_scatter <- renderPlot({
req(scatter_data())
print(head(scatter_data()))
p = ggplot(scatter_data(), aes(x = value1, y = value2)) + geom_point()
return(p)
})
}
I have an r script includes a Identify_IP() that returns a list of dataframe and a ggplot. I want to call the script and render both the dataframe and the plot.
This is Identify_IP() function. I took off unrelative code and kept only the plot, lines and ggplot code to give a clear example of my type of ggplot.
library(ggplot2)
library(matrixStats)
library(fda.usc)
#df <- read.table("name.XLS", header = FALSE)
Identify_IP = function(df1){
mlearn <- df1[,'V7']
formul <- plot(blue_curve$x, blue_curve$y * 30, type = 'l', col = 'blue')
formula_deriv <- lines(blue_curve$x, red_curve$y1 * 30, col = 'red')
p <- ggplot(df1, aes(blue_curve$x)) +
geom_line(aes(y = blue_curve$y, colour = "0 Deriv")) +
geom_line(aes(y = red_curve$y1, colour = "1st Deriv")) +
geom_vline(xintercept = x_loc) + geom_hline(yintercept = 0)
return(list(df1,p))
}
Now, this is a modified Shiny code based on amrr and micstr suggestion.
source('InflectionP2.R', local = TRUE)
library(ggplot2)
library(shiny)
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot")
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
dfs <- Identify_IP(read.table(inFile$datapath))
return(dfs)
})
observeEvent(input$btn, output$what <- renderTable({
dataOP()[[1]]
}))
observeEvent(input$btn1, output$pl <- renderPlot({
pp <- dataOP()
pp[[2]]
}))
}))
This was really helpful in teaching me how to call r script in reactive(). And it makes sense to me. Yet, it render the table but the Display Plot button is not rendering the plot. Does my ggplot in Identify_IP function has anything to do with not being able to display the plot? I also tried print(ggplot(pp[[2]])) and still the same.
I managed to get this working.
Note I used the internal data set iris and made a toy Identify_IP function as I do not have your code.
Note you still need to choose a file to trigger the events but it will ignore that file and use iris data.
Workaround I used [[1]] to get the table not dataOP()$tble
CODE
library(shiny)
library(ggplot2)
# source('InflectionP2.R', local = TRUE)
# MAKE TEST FUNCTION
Identify_IP <- function(mydata) {
#shrink data
tble <- head(mydata)
plt <- ggplot(data = head(mydata),
mapping = aes(y = Sepal.Length,
x = Petal.Length)) + geom_point()
return(list(tble, plt))
}
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot")
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
# ORIGINAL dfs <- Identify_IP(read.table(inFile$datapath))
# using internal dataset for example
dfs <- Identify_IP(iris)
# ORIGINAL list(tble = dfs, plt = dfs)
# lets just return your dfs, its already a list in code above
return(dfs)
})
observeEvent(input$btn, output$what <- renderTable({
#print(dataOP()) # debug line that led to [[1]] idea
# ORIGINAL dataOP()$tble
# just say first in list
dataOP()[[1]]
}))
observeEvent(input$btn1, output$pl <- renderPlot({
#ggplot(dataOP()$plt)
# since already a plot just need to index it
# I found [[2]] worked better than explicit dataOP()$plt
pp <- dataOP()
pp[[2]]
}))
}))
RESULT
Voila!
1) Try print (ggplot(dataOP()$plt))
Take a look at this answer I wrote.
2) Sorry its hard to interpret without your ggplot code bit and data. Given #amrrs questions can you try debug in your Shiny code with print() and str() temporary lines to see what your data is returning. i.e.
print(dataOP()$plt)
str(dataOP())
Worse case, try split your code in two. So Identify_IP code to do the data leg and then make a Print_IP with the ggplot code that just returns the plot. It might rule out your chart is not the problem.
3) Take a look at reactiveValues()
https://shiny.rstudio.com/reference/shiny/0.11/reactiveValues.html
It "bakes" a result that was reactive. The type coming out of your chart may be a reactive type not a chart type. Perhaps share any error messages you are getting.
I have a shiny app with a reactive bit of UI which is used to filter my data. I then use the data for plotting. My reactive bit of UI checks all possible values of a variable, offers them as choices in a selectizeInput and starts with all of the choices selected. In my actual app changes in the filter can take quite a bit of time to run so I have submitButton to prevent the app from constantly updating. The only problem is on the initial startup of the app: It loads the choices in to the dynamic UI and selects them, but because further reactivity is blocked by the submitButton, this information doesn't reach the plot and so it shows an empty plot. All that's needed to get the desired result is hit the sumbitButton once. Once this is done the app works as desired.
I'm looking for a way to make the plot show initially without having to press the submitButton. In my following toy example this could probably be done quite easily by replacing the submitButton with an actionButton so that not all reactivity is frozen, which seems to be the solution in a lot of problems involving submitButtons in other question. However, in my actual app there are numerous inputs and sources of reactivity so configuring the actionButton and capturing all desired effects in observeEvents would be quite tedious when the submitButton does all of this with the only problem being the startup. Are there any other ways I can make the plot show on the first startup but follow the submitButton behavior from then on?
An example app:
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("Cylselectui"),
submitButton("Apply changes")
),
mainPanel(
plotOutput("Carsplot")
)
)
)
server <- function(input, output) {
output$Carsplot <- renderPlot({
plotdata <- subset(mtcars, cyl %in% input$Cylselection) #Filter based on cyl
ggplot(plotdata, aes(x = mpg, y = hp, colour = factor(cyl))) + #Create plot
geom_point()
})
output$Cylselectui <- renderUI({ #Create the cyl selectize ui based on the values of cyl that are in the data
selectizeInput(
'Cylselection', 'Select by Cylinder',
choices = sort(unique(mtcars$cyl)),
selected = sort(unique(mtcars$cyl)),
multiple = TRUE
)
})
}
shinyApp(ui = ui, server = server)
You can use a reactive to check whether the input is null (first time) and then provide your defaults values:
Cylselection <- reactive({
if(is.null(input$Cylselection))
sort(unique(mtcars$cyl))
else
input$Cylselection})
output$Carsplot <- renderPlot({
plotdata <- subset(mtcars, cyl %in% Cylselection()) #Filter based on cyl
ggplot(plotdata, aes(x = mpg, y = hp, colour = factor(cyl))) + #Create plot
geom_point()
})
More elegant is to put your data subset in the reactive:
plotdata <- reactive({
if(is.null(input$Cylselection))
mtcars
else
subset(mtcars, cyl %in% input$Cylselection)})
output$Carsplot <- renderPlot({
ggplot(plotdata(), aes(x = mpg, y = hp, colour = factor(cyl))) + #Create plot
geom_point()
})