I am designing a Shiny app which contains a plotly scatter plot. I would like for the user to be able to click on the graph to record an event using the event_data function, but then be able to clear that event on the click of an actionButton. Some example code can be seen below:
library(shiny)
library(plotly)
ui <- fluidPage(
actionButton("clearEvent", label = "clear event"),
verbatimTextOutput("plotVal"),
plotlyOutput('plot1')
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
d <- diamonds[sample(nrow(diamonds), 1000), ]
plot_ly(d, x = ~carat, y = ~price, color = ~carat,
size = ~carat, text = ~paste("Clarity: ", clarity))
})
output$plotVal <- renderPrint({
e <- event_data("plotly_click")
if (is.null(e)) {
NULL
} else {
e
}
})
observeEvent(input[["clearEvent"]], {
e <- NULL
})
}
shinyApp(ui = ui, server = server)
This doesn't clear the event like I would expect, however. Looking into the code for event_data shows that this is probably because it is stored within the session object itself. Any ideas how I can overwrite it?
The only similar thing I have come across is Clear plotly click event but it's very hacky and doesn't seem to work for me.
In your example, e is just defined in the renderPrint and in the observeEvent and not globally so even if e is changed in the observeEvent, it does not trigger anything in the renderPrint.
You can use reactiveValues for this:
data <- reactiveValues(e=NULL)
observe({
data$e <- event_data("plotly_click")
})
output$plotVal <- renderPrint({
e <- data$e
if (is.null(e)) {
NULL
} else {
e
}
})
observeEvent(input[["clearEvent"]], {
data$e <- NULL
})
data$e is changed whenever the user click the plot or the button, and since there is a dependency on data$e in the renderPrint, that gets updated whenever data$e is changed.
The previous answer partially solves the problem, however, the user cannot click on the same plotly marker again, at least no update is triggered. That problem can be tackled by manually resetting the source of event_data("plotly_click") withshinyjs:
library(shiny)
library(plotly)
library(shinyjs)
ui <- shinyUI(
fluidPage(
useShinyjs(),
# code to reset plotlys event_data("plotly_click", source="A") to NULL -> executed upon action button click
# note that "A" needs to be replaced with plotly source string if used
extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-A', 'null'); }"),
actionButton("reset", "Reset plotly click value"),
plotlyOutput("plot"),
verbatimTextOutput("clickevent")
)
)
server <- shinyServer(function(input, output) {
output$plot <- renderPlotly({
plot_ly(mtcars, x=~cyl, y=~mpg)
})
output$clickevent <- renderPrint({
event_data("plotly_click")
})
observeEvent(input$reset, {
js$resetClick()
})
})
shinyApp(ui, server)
Related
For my app, I need the user to click an area on a plot, then the plot responds to that click and shows a new plot that is linked to that input click.
However, currently it runs, but the new plot only displays for 3 seconds and then goes back to the original plot. I found a similar example here. This plot updates based on a list of reactiveValues then draws those new points the user selected. I think if I find a way to modify it to draw the new plot immediatly after the clicked event it should work, but stuck on this part.
So ideally the below example will add the new point immediatly after beind clicked. In my case I will need to display the new plot until a new area of the plot is clicked.
Example from the link
library(shiny)
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
verbatimTextOutput("info"),
actionButton("updateplot", "Update Plot:")
)
server <- function(input, output) {
val <- reactiveValues(clickx = NULL, clicky = NULL)
observe({
input$plot_click
isolate({
val$clickx = c(val$clickx, input$plot_click$x)
val$clicky = c(val$clicky, input$plot_click$y)
})
}) #adding clicks to list
output$plot1 <- renderPlot({
plot(mtcars$wt, mtcars$mpg)
input$updateplot
isolate({
points(val$clickx, val$clicky)
})
})
output$info <- renderText({
paste0("x = ", val$clickx, ", y = ",val$clicky, "\n")
})
}
shinyApp(ui, server)
This example shows a main plot and upon click in the main plot it shows a sub plot. Once clicked again it shows again the main plot.
The idea is that a counter (trigger) is increased whenever a click happens. It is important to use req(.) in the observer, lest the observer fires again when the mouse button is released (in this case input$plot_click is set to NULL).
The renderPlot(.) then takes a dependency on this trigger and shows either the main or the sub plot.
Update. If you want to use info from the input$plot_click object you should save it as well, to avoid that it get NULL.
library(shiny)
library(ggplot2)
ui <- basicPage(
plotOutput("plot1", click = "plot_click")
)
server <- function(input, output) {
plot_data <- reactiveValues(trigger = 0, x = NA, y = NA)
observe({
req(input$plot_click)
isolate(plot_data$trigger <- plot_data$trigger + 1)
plot_data$x <- input$plot_click$x
plot_data$y <- input$plot_click$y
})
output$plot1 <- renderPlot({
if (plot_data$trigger %% 2 == 0) {
plot(1:10, main = "Main Plot")
} else {
ggplot() + geom_point(aes(x = plot_data$x, y = plot_data$y), size = 5, shape = 19)
}
})
}
shinyApp(ui, server)
Just drop the isolate in your renderPlot:
library(shiny)
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
verbatimTextOutput("info")
)
server <- function(input, output) {
val <- reactiveValues(clickx = NULL, clicky = NULL)
observe({
input$plot_click
isolate({
val$clickx = c(val$clickx, input$plot_click$x)
val$clicky = c(val$clicky, input$plot_click$y)
})
}) #adding clicks to list
output$plot1 <- renderPlot({
plot(mtcars$wt, mtcars$mpg)
points(val$clickx, val$clicky)
})
output$info <- renderText({
paste0("x = ", val$clickx, ", y = ",val$clicky, "\n")
})
}
shinyApp(ui, server)
I would like to fetch nearPoints using the data from a click event.
I have found the below snippet from the Shiny webpage and it works fine as expected.
output$plot <- renderPlot({
d <- data()
plot(d$speed, d$dist)
})
output$plot_clickedpoints <- renderPrint({
# For base graphics, we need to specify columns, though for ggplot2,
# it's usually not necessary.
res <- nearPoints(data(), input$plot_click, "speed", "dist")
if (nrow(res) == 0)
return()
res
})
I tried to mimic the above the approach to identify the nearPoints in the Plotly plots using the click event data. However, it did not work.
output$plot <- renderPlotly({
d <- data()
plot(d$speed, d$dist)
})
output$plot_clickedpoints <- renderPrint({
# For base graphics, we need to specify columns, though for ggplot2,
# it's usually not necessary.
res <- nearPoints(data(), event_data("plotly_click"), "speed", "dist")
if (nrow(res) == 0)
return()
res
})
Any idea on how to pass the coordinate information to the plotly plot?
I am not sure on how to do this with the nearPoints function, but is using that function really necessary? You could find the points that are within a threshold of the clicked point as well with the following code:
library(shiny)
library(plotly)
library(DT)
threshold_mpg = 3
threshold_cyl = 1
shinyApp(
ui <- shinyUI(
fluidPage(
plotlyOutput("plot"),
DT::dataTableOutput("table")
)
),
function(input,output){
data <- reactive({
mtcars
})
output$plot <- renderPlotly({
d <- data()
plot_ly(d, x= ~mpg, y=~cyl, mode = "markers", type = "scatter", source="mysource")
})
output$table<- DT::renderDataTable({
event.data <- event_data("plotly_click", source = "mysource")
print(event.data)
if(is.null(event.data)) { return(NULL)}
# A simple alternative for the nearPoints function
result <- data()[abs(data()$mpg-event.data$x)<=threshold_mpg & abs(data()$cyl-event.data$y)<=threshold_cyl, ]
DT::datatable(result)
})
}
)
Hope this helps.
The "plotly_selected" plotly.js event returns more information than event_data("plotly_selected") actually gives you, including coordinate information (this was arguably a design mistake made by event_data() that's too late to change). Fortunately, if you know a bit of JavaScript, know how to listen to plotly select events, and how to send data from client to a shiny server, you can do something like this to access that info:
library(shiny)
library(plotly)
library(htmlwidgets)
ui <- fluidPage(
plotlyOutput("p"),
verbatimTextOutput("info")
)
server <- function(input, output, session, ...) {
output$p <- renderPlotly({
plot_ly(x = 1:10, y = 1:10) %>%
layout(dragmode = "select") %>%
onRender(
"function(el, x) {
var gd = document.getElementById(el.id);
gd.on('plotly_selected', function(d) {
// beware, sometimes this event fires objects that can't be seralized
console.log(d);
Shiny.onInputChange('my-select-event', d.range)
})
}")
})
output$info <- renderPrint({
print(session$rootScope()$input[["my-select-event"]])
})
}
shinyApp(ui, server)
Using the coordinate information you could write a function that works in a similar way to nearPoints().
I am using plot_click to interrogate a graph in Shiny and would like the conditional panel to show 2 bits of information. However at the moment, the conditional panel shows 'NA' until i perform the plot click, how do i make this disappear?
library(ggplot2)
library(shiny)
# make some data
df <- data.frame(ID=c(1,2),x=c(33,7),y=c(50,16),name=c("Tom","Bill"),link=c("https://mylink.com","https://anotherlink.com"), stringsAsFactors=FALSE)
# Shiny app
ui <- basicPage(
plotOutput("plot", click = "plot_click"),
verbatimTextOutput("selection"),
conditionalPanel("!is.na(output.nametext)",
h4(textOutput("nametext")),
h4(textOutput("urltext")))
)
server <- function(input, output,session) {
output$plot <- renderPlot({
ggplot(data=df,aes(x=x,y=y))+
geom_point()+
scale_x_continuous(limits = c(0, 68))+
scale_y_continuous(limits = c(0, 52.5))
})
output$selection <- renderPrint({
nearPoints(df, input$plot_click)
})
info <- reactive({
t <- as.data.frame(nearPoints(df, input$plot_click))
s <- t[1,4]
u <- t[1,5]
list(s=s,u=u)
})
output$nametext <- renderText({info()$s})
output$urltext <- renderText({info()$u})
}
runApp(shinyApp(ui, server), launch.browser = TRUE)
in the conditionalPanel in the UI, i've tried !is.na(output.nametext), output.nametext != null, output.nametext==true, plot_click==true, plot_click!=null and more. None of them remove the NA that exists before i perform the click.
One solution would be to simply use:
output$nametext <- renderText({
if(!is.na(info()$s)){
info()$s
}
})
You could also use the space to inform the user he should click a point to see information:
output$urltext <- renderText({
if(!is.na(info()$s)){
info()$u
}else{
print("Click on a point to get additional information")
}
})
I'm trying to use click events using the plot_click option in RShiny. What I want to do is:I want to select a particular bubble from the first chart and then the chart below should be populated only for the above selected car. How to do this? Here is my code :
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
plotOutput("plot2")
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mt$wt, mt$mpg)
})
output$plot2 <- renderPlot({
test <- data.frame(nearPoints(mt, input$plot_click, xvar = "wt", yvar = "mpg"))
test2 <- filter(test,Car_name)
car <- test2[1,1]
mt2 <- filter(mt,Car_name == car)
plot(mt2$wt,mt2$mpg)
})
}
shinyApp(ui, server)
I rearranged your server-function a bit. I moved the selected points to a reactive Value, which can be used by print/plot outputs.
Furthermore, i am not exactly sure what you want to achievewith all that filtering. Maybe you could change your original question an make a reproducible example out of it with the mtcars-data, as it seems you are using that.
library(shiny)
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
verbatimTextOutput("info"),
plotOutput("plot2")
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mtcars$wt, mtcars$mpg)
})
selected_points <- reactiveValues(pts = NULL)
observeEvent(input$plot_click, {
x <- nearPoints(mtcars, input$plot_click, xvar = "wt", yvar = "mpg")
selected_points$pts <- x
})
output$info <- renderPrint({
selected_points$pts
})
output$plot2 <- renderPlot({
req(input$plot_click)
test <- selected_points$pts
plot(test$wt,test$mpg)
})
}
shinyApp(ui, server)
The clicked points are stored in the selected_points reactive Value, which is assigned in the observeEvent function.
If you filter a lot in the plot2-function, you would have to use req() or validate(), as it may be possible that no value is left over and therefore nothing can be plotted.
I hope that helps.
I am doing a project where I use the shiny server and connect R to mongodb to fetch results from database and display it dynamically.
However, I face the following problem in it. I initially get the results from db and make a plot. After this plot is done, I want the user to make make two mouse clicks on the plot based on which it should take the two values as xlim and plot a zoomed version of the previous plot. However, I am not able to do it successfully.
Here is the code that I have written.
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("LOAD AND PERFORMANCE DASHBOARD"),
sidebarLayout(
sidebarPanel(
fluidRow(
selectInput("select", label = h3("Select type of testing"),
choices = list("Performance Testing"=1, "Capacity Testing"=2)),
radioButtons("radio", label = h3("Select parameter to plot"),
choices = list("Disk" = 1, "Flit" = 2,"CPU" = 3,"Egress" =4,
"Memory" = 5))
)),
mainPanel(
plotOutput("plot",clickId="plot_click"),
textOutput("text1"),
plotOutput("plot2")
)
)
))
server.R
library(shiny)
library(rmongodb)
cursor <- vector()
shinyServer(function(input, output) {
initialize <- reactive({
mongo = mongo.create(host = "localhost")
})
calculate <- reactive({
if(input$radio==1)
xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "disk")
else if(input$radio==2)
xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "flit")
else if(input$radio==3)
xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "cpu")
else if(input$radio==4)
xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "egress")
else if(input$radio==5)
xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "memory")
})
output$plot <- renderPlot({
initialize()
value <- calculate()
plot(value,xlab="Time",ylab="% Consumed")
lines(value)
cursor <- value
})
output$text1 <- renderText({
paste("You have selected",input$plot_click$x)
})
output$plot2 <- renderPlot({
plot(cursor[cursor<input$plot_click$x && cursor>first_click ],xlab="Time",ylab="% Consumed") lines(cursor)
first_click <- input$plot_click$x
})
})
Thanks in advance for the help :)
Here's a simple example that demonstrates the behavior you want, just run this code (or save as a file and source it). This code uses the new observeEvent function that debuted in Shiny 0.11, which just hit CRAN over the weekend.
The basic idea is that we track two reactive values, click1 and range. click1 represents the first mouse click, if any exists; and range represents the x-values of both mouse clicks. Clicking on the plot simply manipulates these two reactive values, and the plotting operation reads them.
library(shiny)
ui <- fluidPage(
h1("Plot click demo"),
plotOutput("plot", clickId = "plot_click"),
actionButton("reset", "Reset zoom")
)
server <- function(input, output, session) {
v <- reactiveValues(
click1 = NULL, # Represents the first mouse click, if any
range = NULL # After two clicks, this stores the range of x
)
# Handle clicks on the plot
observeEvent(input$plot_click, {
if (is.null(v$click1)) {
# We don't have a first click, so this is the first click
v$click1 <- input$plot_click
} else {
# We already had a first click, so this is the second click.
# Make a range from the previous click and this one.
v$range <- range(v$click1$x, input$plot_click$x)
# And clear the first click so the next click starts a new
# range.
v$click1 <- NULL
}
})
observeEvent(input$reset, {
# Reset both the range and the first click, if any.
v$range <- NULL
v$click1 <- NULL
})
output$plot <- renderPlot({
plot(cars, xlim = v$range)
if (!is.null(v$click1$x))
abline(v = v$click1$x)
})
}
shinyApp(ui, server)