Change plot on click in Shiny

Question

I hope you can help me again as I stumbled over another problem in Shiny:

I would like a graphic to change in the moment it is clicked on. Here's a minimal example:

ui.R (shows a clickable graphic and a text frame)

shinyUI(fluidPage(
  titlePanel("Title"),
  sidebarLayout(
    sidebarPanel(
    ),
    mainPanel(
      plotOutput("graph", width = "100%", click = "plot_click"),
      verbatimTextOutput("click_info")
    )
  )
) 
) 

server.R (graphic just contains "A","B","C","D", on click I get the nearest letter in the text frame)

shinyServer(function(input, output, session) {

  # Visualization output:  
  observe({
    output$graph <- renderPlot({
      data <- data.frame(x=c(1,2,1,2), y=c(1,1,2,2), 
              values=c("A","B","C","D"), stringsAsFactors=FALSE)
      plot(data$x, data$y, pch=data$values)
    })  
  })

  # interaction click in graph  
  observe({
    click <- c(input$plot_click$x, input$plot_click$y)
    data <- data.frame(x=c(1,2,1,2), y=c(1,1,2,2),
                       values=c("A","B","C","D"), stringsAsFactors=FALSE)
    nearest_point <- which.min(apply(data[,1:2], 1, function(a) sum(((click-a)^2))))
    id <- data$values[nearest_point]
    output$click_info <- renderPrint({
      id
    })
  })
})

Now what I want is to mark the letter I clicked on in the graph, for example by another color. But all my tries failed so far.

Answer 1

Try this:

ui <- shinyUI(fluidPage(
  titlePanel("Title"),
  sidebarLayout(
    sidebarPanel(
    ),
    mainPanel(
      plotOutput("graph", width = "100%", click = "plot_click"),
      verbatimTextOutput("click_info")
    )
  )
) 
)

server <- shinyServer(function(input, output, session) {
  data <- data.frame(x=c(1,2,1,2), y=c(1,1,2,2), 
                     values=c("A","B","C","D"), stringsAsFactors=FALSE)

  # Visualization output:  
  observe({
    output$graph <- renderPlot({
      plot(data$x, data$y, pch=data$values)
    })  
  })


  # interaction click in graph  
  observe({
    if(is.null(input$plot_click$x)) return(NULL)
    click         <- c(input$plot_click$x, input$plot_click$y)
    print(click)
    nearest_point <- which.min(apply(data[,1:2], 1, function(a) sum(((click-a)^2))))
    id <- data$values[nearest_point]

    output$click_info <- renderPrint({
      id
    })
    color <- rep("black",length(data$x))
    color[data$values==id] <- "red"

    isolate({
      output$graph <- renderPlot({
        plot(data$x, data$y, pch=data$values, col=color)
      }) 
    })

  })
})
shinyApp(ui=ui,server=server)

With ggplot2

Edited as per @bunks suggestions:

library(ggplot2)
library(shiny)

ui <- shinyUI(fluidPage(
  titlePanel("Title"),
  sidebarLayout(
    sidebarPanel(
    ),
    mainPanel(
      plotOutput("graph", width = "100%", click = "plot_click"),
      verbatimTextOutput("click_info")
    )
  )
))

server <- shinyServer(function(input, output, session) {
  data <- data.frame(x=c(1,2,1,2), 
                         y=c(1,1,2,2), 
                         values=c("A","B","C","D"), 
                         stringsAsFactors=FALSE, 
                         color=rep("1",4))
  makeReactiveBinding('data')

  output$graph <- renderPlot({
    ggplot(data=data,aes(x=x,y=y,label=values,color=color))+geom_text()+theme_classic()+guides(colour=FALSE)
  })  

  observeEvent(input$plot_click, {
    # Get 1 datapoint within 15 pixels of click, see ?nearPoints
    np <- nearPoints(data, input$plot_click, maxpoints=1 , threshold = 15)

    output$click_info <- renderPrint({np$values})

    data$color <<- rep("1",length(data$x))
    data$color[data$values==np$values] <<- "2"
  })
})
shinyApp(ui=ui,server=server)