Jordan
Jordan

Reputation: 465

How to display plot clicks on a plot in shiny

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

Answers (2)

DeanAttali
DeanAttali

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

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

Related Questions