Overlaying a mix of click and hover coordinates on image in shiny

[condwanaland]

I have a shiny app here that loads an image, and has a 'dblClick' and a 'hover' method on the image. When you double click on the image, it stores the coordinates in a dataframe. When two sets of coordinates are stored, it draws a line between the two points.

What I'd like to do is make the 1st row of the dataframe made by the double click, and the 2nd row made by the hover. This should allow a 'live' transect, where you can click a starting point, and then have a transect drawn between the first click, and wherever the mouse is resting. When a 2nd double click is made it should 'confirm' that point, and the hover should no longer affect the transect.

This should only ever be a two row dataframe (i.e., a single transect defined by two points) - so it can either be a double click and the hover, or 1st double click and 2nd double click. Future clicks shouldn't do anything.

I've got the two sets of double clicks working fine, but I cant figure out how to have the hover drawn the line when I havent yet made a 2nd double click.

library(shiny)
library(magick)
library(ggplot2)


create_image <- function(loaded_image, image_data) {

  displayed_image <- magick::image_ggplot(loaded_image)
  displayed_image <- displayed_image +
    geom_point(data = image_data, aes(x = .data$x_values,
                                      y = .data$y_values)) +
    geom_path(data = image_data, aes(x = .data$x_values,
                                      y = .data$y_values
    ),
    color = "black")
  return(displayed_image)
}



ui <- fluidPage(

   titlePanel(""),

   sidebarLayout(
      sidebarPanel(
      ),

      mainPanel(
        plotOutput("current_image_plot", dblclick = "double_click", hover = "hover")
      )
   )
)

server <- function(input, output) {

  image_data <- shiny::reactiveValues()
  image_data$double_click <- data.frame(x_values = numeric(), y_values = numeric())

  loaded_image <- image_read("https://jeroen.github.io/images/frink.png")

  output$current_image_plot <- renderPlot({
    displayed_image <- create_image(loaded_image,
                                    image_data$double_click
                                    )
    return(displayed_image)
  })

  observeEvent({input$double_click
                input$hover}, {
    add_row <- data.frame(x_values = input$double_click$x,
                          y_values = input$double_click$y)

    image_data$double_click <- rbind(image_data$double_click, add_row)
  })


}

shinyApp(ui = ui, server = server)

[nirgrahamuk]

library(shiny)
library(magick)
library(ggplot2)


create_image <- function(loaded_image, image_data) {
  
  displayed_image <- loaded_image +
    geom_point(data = image_data, aes(x = .data$x_values,
                                      y = .data$y_values)) +
    geom_path(data = image_data, aes(x = .data$x_values,
                                     y = .data$y_values
    ),
    color = "black")
  return(displayed_image)
}



ui <- fluidPage(
  
  titlePanel(""),
  
  sidebarLayout(
    sidebarPanel(
    ),
    
    mainPanel(
      plotOutput("current_image_plot", dblclick = "double_click", hover = "hover")
    )
  )
)

server <- function(input, output) {
  
  image_data <- shiny::reactiveValues()
  image_data$double_click <- data.frame(x_values=c(NA_real_,NA_real_), y_values = c(NA_real_,NA_real_))
  
  loaded_image <- magick::image_ggplot(image_read("https://jeroen.github.io/images/frink.png"))
  
  output$current_image_plot <- renderPlot({
    displayed_image <- create_image(loaded_image,
                                    image_data$double_click
    )
    return(displayed_image)
  })
  
  observeEvent({input$double_click}, {
    clickrow <- data.frame(x_values = input$double_click$x,
                           y_values = input$double_click$y)
    
    image_data$double_click[1,] <- clickrow
    
    new_hov<-reactive(
      input$hover
    )  %>% debounce(millis = 150)
    
    observeEvent(new_hov(), {
      nh <- new_hov()
      hoverrow <- data.frame(x_values = nh$x,
                             y_values = nh$y)
      
      image_data$double_click[2,] <- hoverrow
    })
  })
  

  
}

shinyApp(ui = ui, server = server)

[condwanaland]

Hey @nirgrahamuk - thanks for the response.

So this works really well for the intial double click+ hover functionality! However, when I do a 2nd double click, it does not 'confirm' the 2nd point and then just keep the static transect there. When I double click again, it just starts a new transect at that location

Is there a way to use the 2nd double click to confirm the end location?