Here is my basic "rubber-banding" - it works in principle, but is totally unusable:
- Displaying the png in plotly needs a few seconds on my very fast computer (60 ms for the bare-bone version)
- Click first is ok
- But hovering and display of the rubberband is unacceptably slow
Back to the basics? Or my error using plotly?
library(shiny)
library(png)
library(plotly)
library(tidyverse)
if (!file.exists("a.png"))
curl::curl_download("https://menne-biomed.de/uni/a.png", "a.png")
myimg <- readPNG("a.png")
img_height <- dim(myimg)[1]
img_width <- dim(myimg)[2]
ui <- fluidPage(
plotlyOutput("p1")
)
server <- function(input, output, session) {
first_point = NULL
output$p1 <- renderPlotly({
plot_ly(type="image",z=myimg*255,
source = "myimg") %>%
event_register("plotly_click") %>%
event_register("plotly_hover") %>%
config(displayModeBar = FALSE)
})
observe({
e <- event_data(event="plotly_click",source = "myimg")
req(e)
print("Click \n")
first_point <<- e
plotlyProxy("p1") %>%
plotlyProxyInvoke(method="addTraces",list(x = c(e$x, e$x),
y = c(e$y, e$y),
type="scatter",
mode="markers"))
})
observe({
e <- event_data(event="plotly_hover", source = "myimg", priority = "event")
req(e)
req(first_point)
cat("Hover \n")
plotlyProxy("p1") %>%
plotlyProxyInvoke(method="deleteTraces",list(as.integer(1))) %>%
plotlyProxyInvoke(method="addTraces",list(x = c(first_point$x, e$x),
y = c(first_point$y, e$y),
type="scatter",
mode="lines"))
})
}
shinyApp(ui, server)