R Shiny recoloring of points - r

Question

I would like click-select points and group them based on color.
I can save selected points with color information into a new data frame and plot it, however I would like to keep track and see what was already selected on the interactive plot.
How can I show/label already selected points or make it permanent after "Add selection"?
library(shiny)
library(tidyverse)
library(DT)
library(colourpicker)
ui = fluidPage(
colourInput("col", "Select colour", "purple"),
actionButton("addToDT", "Add selection", icon = icon("plus")), hr(),
plotOutput("plot", click = "plot_click", dblclick = "plot_reset"),
DT::dataTableOutput('plot_DT'), hr(),
textOutput("clickcoord"),
DT::dataTableOutput('final_DT'),
plotOutput("plotSelected")
)
server = function(input, output, session) {
selectedPoint = reactiveVal(rep(FALSE, nrow(mtcars)))
output$clickcoord <- renderPrint({
print(input$plot_click)
})
observeEvent(input$plot_click, {
clicked = nearPoints(mtcars, input$plot_click, allRows = TRUE)$selected_
selectedPoint(clicked | selectedPoint())
})
observeEvent(input$plot_reset, {
selectedPoint(rep(FALSE, nrow(mtcars)))
})
output$plot_DT = DT::renderDataTable({
mtcars$sel = selectedPoint()
mtcars = dplyr::filter(mtcars, sel == TRUE) %>% mutate(group_color = input$col)
})
final_DT = reactiveValues()
final_DT$df = data.frame()
FinalData = eventReactive(input$addToDT, {
mtcars$sel = selectedPoint()
mtcars = dplyr::filter(mtcars, sel == TRUE) %>% mutate(group_color = input$col)
final_DT$df = bind_rows(final_DT$df, mtcars)
})
output$final_DT = renderDataTable({FinalData()})
output$plot = renderPlot({
mtcars$sel = selectedPoint()
ggplot(mtcars, aes(wt, mpg, color = mtcars$sel, fill=mpg)) +
geom_point(shape = 21, size = 6, stroke = 2) +
scale_color_manual(values = c("#ffffff00", input$col)) +
scale_fill_viridis_c() +
theme_bw()
})
output$plotSelected = renderPlot({
sel_df = FinalData()
ggplot(sel_df, aes(wt, mpg, fill = group_color, colour = group_color)) +
geom_point(shape = 21, size = 6, stroke = 2) +
scale_color_manual(values = unique(sel_df$group_color)) +
scale_fill_manual(values = unique(sel_df$group_color)) +
theme_bw()
})
observeEvent(input$addToDT, {
selectedPoint(rep(FALSE, nrow(mtcars)))
})
}
shinyApp(ui, server)

Answer 1

I think this is the "crux" of what your are looking for. I used a very similar example that I found in the help for entitled:
A demonstration of clicking, hovering, and brushing
(https://shiny.rstudio.com/reference/shiny/0.13.1/plotoutput)
It is very similar to your example.
I create a matrix of T/F elements where the rows are the observations and the columns are in which batch the observation is selected. So when you launch the whole matrix is False, but as you click on observations the switch to positive in the first column. Then if you click addSelection and continue you start switching the observations in the next column.
Could you confirm that this what you are looking for?
Below is the code.
shinyApp(
ui = basicPage(
fluidRow(
column(
width = 4,
plotOutput("plot",
height = 300,
click = "plot_click", # Equiv, to click=clickOpts(id='plot_click')
),
actionButton("addToDT", "Add selection", icon = icon("plus")), hr(),
h4("Clicked points"),
tableOutput("plot_clickedpoints"),
),
column(
width = 4,
verbatimTextOutput("counter"),
),
)
),
server = function(input, output, session) {
data <- reactive({
input$newplot
# Add a little noise to the cars data so the points move
cars + rnorm(nrow(cars))
})
output$plot <- renderPlot({
d <- data()
plot(d$speed, d$dist, main = paste("No of Sets Chosen", input$addToDT))
})
output$plot_clickinfo <- renderPrint({
cat("Click:
")
str(input$plot_click)
})
selectedPoints <- reactiveVal(rep(FALSE, nrow(cars)))
selectionMatrix <- reactiveVal(matrix(data = F, nrow = nrow(cars), ncol = 7))
observeEvent(input$plot_click, {
clicked <- nearPoints(data(), input$plot_click, "speed", "dist", allRows = TRUE)$selected
selectedPoints(clicked | selectedPoints())
tmp <- unlist(selectionMatrix())
tmp[, (input$addToDT + 1)] <- selectedPoints()
selectionMatrix(tmp)
})
observeEvent(input$addToDT, {
selectedPoints(rep(FALSE, nrow(cars)))
})
output$plot_clickedpoints <- renderTable({
# if (input$addToDT==0) {
res <- selectionMatrix()
return(res)
})
}
)