Change plot on click in Shiny - r

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)