Reputation: 465
I would like users to be able to click on a plot, and when they do record leave a mark or a message at that the point they clicked.
I am using reactive values within the plotting environment. This seems to be resetting the plot. Almost immediately after the message appears.
Here is a minimum not-fully-working example
library(shiny)
## ui.R
ui <- fluidPage(
shinyjs::useShinyjs(),
column(12,
plotOutput("Locations", width=500, height=500,
click="plot_click") )
)
## server.R
server <- function( input, output, session){
## Source Locations (Home Base)
source_coords <- reactiveValues(xy=c(x=1, y=2) )
## Dest Coords
dest_coords <- reactive({
if (is.null(input$plot_click) ){
list( x=source_coords$xy[1],
y=source_coords$xy[2])
} else {
list( x=floor(input$plot_click$x),
y=floor(input$plot_click$y))
}
})
## Calculate Manhattan Distance from Source to Destination
DistCost <- reactive({
list( Lost=sum( abs(
c(dest_coords()$x, dest_coords()$y) - source_coords$xy
) ) )
})
## RenderPlot
output$Locations <- renderPlot({
par(bg=NA)
plot.new()
plot.window(
xlim=c(0,10), ylim=c(0,10),
yaxs="i", xaxs="i")
axis(1)
axis(2)
grid(10,10, col="black")
box()
## Source
points( source_coords$xy[1], source_coords$xy[2], cex=3, pch=intToUtf8(8962))
## Destination
text(dest_coords()$x, dest_coords()$y, paste0("Distance=", DistCost() ))
})
}
### Run Application
shinyApp(ui, server)
Upvotes: 1
Views: 2382
Reputation: 26323
I'm not sure if the intent was to only show the most recently clicked point, or to show all the points clicked. Since the answer by Pawel covers the former case (and is already an accepted answer, which means it probably was the intent), I'll post a solution to the former, for future reference in case it helps anymore
library(magrittr)
library(shiny)
## ui.R
ui <- fluidPage(
shinyjs::useShinyjs(),
column(12,
plotOutput("Locations", width=500, height=500,
click="plot_click") )
)
## server.R
server <- function( input, output, session){
initX <- 1
initY <- 2
## Source Locations (Home Base)
source_coords <- reactiveValues(xy=c(x=initX, y=initY) )
## Dest Coords
dest_coords <- reactiveValues(x=initX, y=initY)
observeEvent(plot_click_slow(), {
dest_coords$x <- c(dest_coords$x, floor(plot_click_slow()$x))
dest_coords$y <- c(dest_coords$y, floor(plot_click_slow()$y))
})
## Don't fire off the plot click too often
plot_click_slow <- debounce(reactive(input$plot_click), 300)
## Calculate Manhattan Distance from Source to Destination
DistCost <- reactive({
num_points <- length(dest_coords$x)
list( Lost= lapply(seq(num_points), function(n) {
sum( abs(
c(dest_coords$x[n], dest_coords$y[n]) - source_coords$xy
) )
}) )
})
## RenderPlot
output$Locations <- renderPlot({
par(bg=NA)
plot.new()
plot.window(
xlim=c(0,10), ylim=c(0,10),
yaxs="i", xaxs="i")
axis(1)
axis(2)
grid(10,10, col="black")
box()
## Source
points( source_coords$xy[1], source_coords$xy[2], cex=3, pch=intToUtf8(8962))
## Destination
text(dest_coords$x, dest_coords$y, paste0("Distance=", DistCost()$Lost ))
})
}
### Run Application
shinyApp(ui, server)
Upvotes: 5
Reputation: 1118
The problem is that input$plot_click
flushes itself immediately after it gets values from user click, and returns to NULL
. You can test if by yourself by creating empty list stored <- list()
, and after that add
stored[[length(stored)+1]] <<- as.character(c(input$plot_click$x, input$plot_click$y))
inside your dest_coords reactive. You can see that if you click the plot just once it will store three values. First is NULL
, second is the clicked point coordinates, but there will be also the third one, which is NULL
again. So it will flush its values away immediately after pushing them to reactives which are dependent at him. But the reactives will also take dependency at any change in the input, even if it is NULL
. The way around this is to use eventReactive
or observeEvent
and make sure that ignoreNULL
parameter is set to TRUE
(it is actually set to TRUE
by default). To make it work for your app, you should already store all the minimum values required to create your plot in reactiveValues
, and after the click is made just overwrite data with those provided by input$plot_click
.
Here is my modified example:
library(shiny)
## ui.R
ui <- fluidPage(
shinyjs::useShinyjs(),
column(12,
plotOutput("Locations", width=500, height=500,
click="plot_click"))
)
## server.R
server <- function( input, output, session){
source_coords <- reactiveValues(xy=data.frame(x=c(1,1), y=c(1,1)))
observeEvent(input$plot_click, {
source_coords$xy[2,] <- c(input$plot_click$x, input$plot_click$y)
})
## RenderPlot
output$Locations <- renderPlot({
par(bg=NA)
plot.new()
plot.window(
xlim=c(0,10), ylim=c(0,10),
yaxs="i", xaxs="i")
axis(1)
axis(2)
grid(10,10, col="black")
box()
## Source
points( source_coords$xy[1,1], source_coords$xy[1,2], cex=3, pch=intToUtf8(8962))
## Destination
text(source_coords$xy[2,1], source_coords$xy[2,2], paste0("Distance=", sum(abs(source_coords$xy[1,]-source_coords$xy[2,]))))
})
}
### Run Application
shinyApp(ui, server)
Upvotes: 2