Interactive rubber-band line on background graphics

shiny
1

I want to draw interactively a line on an png graphics, and tried to get the example here by @ @pieterjanvc to work.

However, I did not get a response, not even an error message from the example. Has something changed in Shiny/JS handling?

2

I made an alternative for you, avoiding explicit javascript.



library(shiny)
library(png)
library(plotly)
library(tidyverse)
myimg <- readPNG(system.file(package="png","img","Rlogo.png"))
img_height <- dim(myimg)[1]
img_width <- dim(myimg)[2]

ui <- fluidPage(
  plotlyOutput("p1")
)

server <- function(input, output, session) {
  
 output$p1 <- renderPlotly({
    plot_ly(type="image",z=myimg*255,
            source = "myimg") %>% event_register("plotly_click") %>%
     config(displayModeBar = FALSE)
  })
 
 observe({
   e <- event_data(event="plotly_click",source = "myimg")
   str(e)
   print(rep(e$y,2))
    p <- plotlyProxy("p1")
    p %>% plotlyProxyInvoke(method="deleteTraces",list(as.integer(1)))  %>%
      plotlyProxyInvoke(method="addTraces",list(x=c(0,img_width-1),
                                                y=rep(e$y,2),
                                                type="scatter",
                                                mode="lines"))
 })
}

shinyApp(ui, server)
3

Thanks, I always shied away from plotly, because when it had limiting license terms when it came out. I know that this is no longer true, but old habits...

The example is not exactly what I need, but it should give me a start. I try to measure the distance between two points on a color-coded map-like structure by clicking on start - (drag line visible) - (click to store) similarly to the distance measurement provided by google maps.

Sorry, I have to leave now, I will try again on Monday.

4

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)
5

You might look at adapating this , though that may require some javascript knowledge.

6

Thanks, I have tried it and decided that the version I cited in the original post was closer to the problem. The example you mentioned makes use of the default css borders, which is elegant but as far I see cannot simply be converted to lines.

Another interesting inspiration - even if a bit over the top - is

7

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.