Translating HTML coordinates to plot coordinates

Hi,

I found a solution! I'm so happy as this question of yours made me spent 2 days searching for a solution as I was convinced there was a way, but I didn't have the JS skills :slight_smile:

This is the code:

library(shiny)
library(shinyjs)
library(phonTools)

# Define UI for application that draws on a spectrogram
ui <- fluidPage(
 tags$head(
   tags$style(HTML("
                   .spectrum {
                     pointer-events: none;
                     position: absolute;
                     left: 0;
                     top: 0;
                     width: 600px;
                     height: 400px;
                   }
                   
                   .wrapper {
                     position: relative;
                     width: 600px; 
                     height: 400px;
                     visibility: visible;
                     -moz-user-select: none;
                     -webkit-user-select: none;
                     -ms-user-select: none;
                     user-select: none;
                   }
                   
                   #allSpectrum {
                     position: relative;
                   }
                   "))
   
 ),
 titlePanel("Wait for image load, and then click on the spectrogram!"),
 useShinyjs(),
 
 
 
 bootstrapPage(
   tags$script(HTML(
     "
     $(document).on('shiny:inputchanged', function(event) {
       if (event.name === 'plot1_click') {
         console.log(event.value);
         var canvas = document.getElementById('spectrum1');
         if (canvas.getContext) 
         {
           var context = canvas.getContext('2d');
           context.clearRect(0, 0, 600, 400);
           // Reset the current path
           context.beginPath(); 
           context.moveTo(event.value.coords_css.x +15, 0);
           context.lineTo(event.value.coords_css.x +15, 1400);
           context.stroke();
         } 
       }
     });
     "
   )),
   
   # Show a spectogram
   mainPanel(
     div(id ="wrapper",
         plotOutput("allSpectrum", click = "plot1_click"),
         HTML("<canvas id='spectrum1' class='spectrum' width=600 height=400'></canvas>")
     ),
     textOutput("xpos")
   )
 )
)

server <- function(input, output, session) {
 data(sound)
 spec1 = spectrogram(sound, windowlength = 24, show = F)
 
 output$allSpectrum <- renderPlot({
   plot(spec1)
 })
}

# Run the application 
shinyApp(ui = ui, server = server)

EXPLANATION

Step 1: registering the click on the plot behind the canvas
I found out that you are able through css to make elements 'invisible' for clicks using the pointer-events: none; attribute. This means that if there is an element behind the ignored one, that one will receive the click instead. In our case, we have the plot in the background receiving the click, and the spectrum element on top that will be visible, but not receive clicks. (see the CSS for .spectrum)

Step 2: capturing the plot click in JS
Shiny is the one creating the click event (plot1_click) but we don't want it to trigger any R code as it would refresh the plot. Instead, we divert the event to JS. I figured out this can be done with line $(document).on('shiny:inputchanged', function(event) {}. For a full list of things JS observes see this page.

Event has 3 attributes for shiny:inputchanged, of which the name and value are the ones of interest. By filtering on name, we ensure that the code will only trigger when the plot is clicked. if (event.name === 'plot1_click') {}

Step 3: plot the line in the spectrum div
By using the debug line console.log(event.value); I was able to see the content of the Shiny click event object in the console of my browser. After some experimentation, I then found out the attribute event.value.coords_css.x was the one I was looking for. All I did then was plug that into the code you'd written before, and the line was plotted! I did however have to adjust the value by 15 px as I think this is because of the plot margins.

So there you go, a complex plot with a super fast CSS line plotted over it :slight_smile:

Let me know what you think...
Grtz,
PJ

5 Likes