Selecting point with shiny and plotly - r

Question

I have been trying for some time to debug my Shiny gadget but still cannot manage it. Really appreciate any help.
My gadget consists of a scatterplot generated with Plotly. The user can click one of the points, which will allow you to change some parameters associated with that point. To emphasise the fact that the user has selected that point, I wanted to highlight the selected point.
Alternatively, the user can also select a point from a dropdown menu, which also should highlight the corresponding point.
As an added feature, I want to additionally highlight points that are below a certain threshold on the x axis. This threshold is represented by a dotted line, which you can turn on and off, and move the value of the threshold.
In summary, the points on the plot should all be blue circles, except for the following two cases:
if it is clicked, i.e. it is the "active point" (this should create a red border around the point)
if it is below the threshold on the x-axis (the point should turn to an orange square)
If it is active AND below the threshold, it should be an orange square with a red border, as you would expect.
My gadget works, kind of. But in some cases not. In the example below, one of the points is already below the threshold, but when I select that point, the red marker appears on another point! Despite the active variable being the correct one.
I also get a weird behaviour that the points turn purple if the threshold is below all of the points. But if I move the threshold to be above one of the points, the colours are corrected.
I have a suspicion that this is something to do with the points being on different traces? Therefore when I try to highlight certain points, perhaps I am not indexing the vector as I am expecting. But I am finding it really difficult to debug inside Shiny and Plotly, and I have no good understanding of the Plotly object, so I don't have much clue as to what is going on.
The code below is a reproducible example. You have to run "dat1" through the "rew8r" function. I have taken out other features of the app to try to focus on the problem. Thanks very much to anyone who might take the time to have a look at this, and give any hints!
library(plotly)
library(dplyr)
library(shiny)
library(reactable)
dat1 <- data.frame(
Indicator = c("v1","v2","v3"),
Weight = rep(1,3),
Correlation = c(0.1, 0.8, 0.6) )
rew8r <- function(dat){
# get indicator names
inames <- dat$Indicator
## Create the shiny UI layout
ui <- fluidPage(
# the side panel
sidebarPanel(
selectInput("vseldrop", "Select indicator here or by clicking a point on plot.",
c("<Select>",inames)),
hr(style = "border-top: 1px solid #000000;"),
fluidRow(
column(6,numericInput("locorval", "Low correlation threshold:", 0.2, min = -1, max = 1, step = 0.05)),
column(6,br(),checkboxInput("locorsw", "Enable", value = FALSE)))
),
# the main panel (graph, table, etc)
mainPanel(
plotlyOutput("corrplot"),
textOutput("info")
)
)
## Create the Shiny Server layout
server <- function(input, output, session) {
# this is the plotly click data
event.data <- reactive({event_data(event = "plotly_click", source = "scplot")})
# First, monitor which variable is active
# Create reactive value for active var
acvar <- reactiveVal(NULL)
# update active variable via plot click
observeEvent(event.data(),{
acvar(event.data()$key)})
# update active variable via dropdown
observeEvent(input$vseldrop,
acvar(input$vseldrop))
## Create the plotly plot that compares price vs scoops
output$corrplot <- renderPlotly({
# colours around markers when selected or not
lincol <- ifelse(inames %in% acvar(), "red", "blue")
# size of line around marker (set to 0 if not selected)
linsize <- ifelse(inames %in% acvar(), 3, 0)
# symbol when above/below corr threshold
symbs <- if(input$locorsw==TRUE){c(16,15)}else{c(16,16)}
# colour when above/below threshold
pcols <- if(input$locorsw==TRUE){c("blue", "orange")}else{c("blue", "blue")}
# generate main plot
p <- plot_ly(dat, x = ~Correlation, y = ~Weight, type = "scatter", mode = "markers",
text = ~Indicator, key = ~Indicator, source = "scplot",
marker = list(size = 10, line = list(color = lincol, width = linsize)),
symbol = ~Correlation < input$locorval, symbols = symbs,
color = ~Correlation < input$locorval, colors = pcols) %>%
layout(showlegend = FALSE, yaxis = list(
range = c(0, 1.25),
autotick = FALSE,
dtick = 0.25),
xaxis = list(
range = c(-0.5, 1),
autotick = FALSE,
dtick = 0.2))
# add low correlation line, if activated
if(input$locorsw==TRUE){
p <- p %>% add_segments(x = input$locorval, xend = input$locorval, y = 0, yend = 1.25,
marker = list(color = 'red', opacity=0),
line = list(dash = 'dash')) %>%
layout(showlegend = FALSE)
}
p
})
# Text info
output$info <- renderText({
paste(acvar(), class(acvar()))
})
# update dropdown menu
observeEvent(acvar(),{
updateSelectInput(session, "vseldrop", selected = acvar())
})
}
runGadget(ui, server, viewer = browserViewer())
}