Flexibel location of hover message while preventin

Question

In an app with dynamic number of plots rendered and scaled inside a fixed div I'm trying to solve the final scenario, where in an arrangement of plots over multiple columns and multiple rows, the message should not end up going outside the grouping object.

In an attempt to make hover messages over ggplots I have so far achieved the following with previous questions:

Hover over a single plot without going off screen Question i.e. Hover over multiple plots Question2 and an attempt to improve the correction for going off screen. I posted the current best working version there, and then tried to use the last edit posted in the comments there, but the code seems to be correcting a bit too much. The message almost always ends up vertically centered above the top row plot.

• instead of correcting when the message would overlap the entire multi panel, it seems to react to overlapping the bottom of any single plot

• the correction sends it to coordinates in the top row of plots rather than the relevant row of plots we are hovering over.

That version of the javascript (not working a intended) looks like this currently:

 runjs(paste0( "$('[id=FP1PlotMultiplot]').off('mousemove.x').on('mousemove.x', function(e) {",
                "  $('#my_tooltip').show();",
                "  var tooltip = document.getElementById('my_tooltip');",
                "  var rect = tooltip.getBoundingClientRect();",
                "  var hoverLeft = ", hover$left, ";",
                "  var hoverTop = ", hover$top, ";",
                "  var imgWidth = e.target.width;",
                "  var imgHeight = e.target.height;",
                "  var offX = 2*hoverLeft > imgWidth ? -rect.width : 0;",
                "  var offY = 2*hoverTop > imgHeight ? -rect.height+30 : 30;",
                "  var shiftY = e.offsetY + offY;",
                "  shiftY = shiftY + rect.height > imgHeight ? 20 + imgHeight - rect.height : shiftY;",
                "  shiftY = Math.max(20, shiftY);",
                "  $('#my_tooltip').css({",
                "    top: shiftY + 'px',",
                "    left: e.offsetX + e.target.offsetLeft + offX + 'px'",
                "  });",
                "});") )

Which in a way is nice that we don't need to predetermine any sizes, but as the images below show, doesn't exactly do what I am looking for.

The previous version worked nice for flipping the plots, but did not check whether the message would actually fit after flipping it between the anchor point and the edge of the multiplot object (FP1PlotMultiplot)

  #width per plot = 1000 / nr of cols
  #height per plot = 600 / nr of rows
Ylim <- 250  # half of the height per plot
Ylim <- 150 #half the height per plot

offX <- if(hover$left  > Xlim) {1000} else {30} 
offY <- if(hover$top  > Ylim) {1000} else {50}

runjs(paste0( "$('[id=FP1PlotMultiplot]').off('mousemove.x').on('mousemove.x', function(e) {",
              "  $('#my_tooltip').show();",
              "  var tooltip = document.getElementById('my_tooltip');",
              "  var rect = tooltip.getBoundingClientRect();",
              "  var offX = ", offX, ";",
              "  var offY = ", offY, ";",
              "  offX = offX === 1000 ? -rect.width : offX;",
              "  offY = offY === 1000 ? -rect.height +30 : offY;",
              "  offY = e.offsetY +e.target.offsetTop + rect.height >= 640 ? -rect.height +30 :offY;",
              "  $('#my_tooltip').css({",
              "    top: e.offsetY + e.target.offsetTop + offY + 'px',",
              "    left: e.offsetX + e.target.offsetLeft + offX + 'px'",
              "  });",
              "});") )

FULL Test app showing the "nearly working" version

 require('shiny')
  require('ggplot2')
  require('DT')
  require('shinyjs')
  library('shinyBS')

  ui <- pageWithSidebar(

    headerPanel("Hover off the page"),
    sidebarPanel(width = 2,

                 verbatimTextOutput('leftPix'),
                 verbatimTextOutput('topPix')
    ),
    mainPanel(
      shinyjs::useShinyjs(),
      tags$head(
        tags$style('
                   #my_tooltip {
                   position: absolute;
                   pointer-events:none;
                   width: 10;
                   z-index: 100;
                   padding: 0;
                   font-size:10px;
                   line-height:0.6em
                   }
                   ')
        ),

      uiOutput('FP1PlotMultiplot'),

      uiOutput('my_tooltip'),
      style = 'width:1250px'
        )
      )

  server <- function(input, output, session) {


    output$FP1Plot_1 <- renderPlot({
      ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() +
        theme(legend.position = "none")
    })

    output$FP1Plot_2 <- renderPlot({
      ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() +
        theme(legend.position = "none")
      })

    output$FP1Plot_3 <- renderPlot({
      ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() +
        theme(legend.position = "none")
    })

    output$FP1Plot_4 <- renderPlot({
      ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() +
        theme(legend.position = "none")
    })

    output$FP1PlotMultiplot<- renderUI({


      plot_output_list <- list()

      for(i in 1:4) {
        plot_output_list <- append(plot_output_list,list(
          div(id = paste0('div', 'FP1Plot_', i),
              wellPanel(
                plotOutput(paste0('FP1Plot_', i),
                           width = 500,
                           height = 300,
                           hover = hoverOpts(id = paste('FP1Plot', i, "hover", sep = '_'), delay = 0)
                ),
                style = paste('border-color:#339fff; border-width:2px; background-color: #fff; width:',  540, 'px; height:', 340, 'px', sep = '')),
              style = paste('display: inline-block; margin: 2px; width:', 540, 'px; height:', 340, 'px', sep = ''))

        ))
      }
      do.call(tagList, plot_output_list)

    })








    # turn the hovers into 1 single reactive containing the needed information
    hoverReact <- reactive({
      eg <- expand.grid(c('FP1Plot'), 1:4)
      plotids <- sprintf('%s_%s', eg[,1], eg[,2])
      names(plotids) <- plotids

      hovers <- lapply(plotids, function(key) input[[paste0(key, '_hover')]])

      notNull <- sapply(hovers, Negate(is.null))
      if(any(notNull)){
        plotid <- names(which(notNull))
        plothoverid <- paste0(plotid, "_hover")

        hover <- input[[plothoverid]]
        if(is.null(hover)) return(NULL)
        hover
      }
    })

    ## debounce the reaction to calm down shiny
    hoverReact_D <- hoverReact %>% debounce(100)  ## attempt to stop hoverData <- reactive({}) from firing too often, which is needed when you have 10k point scatter plots.....

    hoverData <- reactive({
      hover <- hoverReact_D() 
      if(is.null(hover)) return(NULL)
      ## in my multi plot multi data frame I look up which dataframe to grab based on hover$plot_id as well as which x and y parameter are plotted
      hoverDF <- nearPoints(mtcars, coordinfo = hover, threshold = 15, maxpoints = 1, xvar = 'wt', yvar = 'mpg')
      hoverDF
    })



    hoverPos <- reactive({
      ## here I look up the position information of the hover whenevver hoverReact_D and hoverData change 
      hover <- hoverReact_D()
      hoverDF <- hoverData()
      if(is.null(hover)) return(NULL)
      if(nrow(hoverDF) == 0) return(NULL)

      ## in my real app the data is already 
      X <- hoverDF$wt[1]
      Y <- hoverDF$mpg[1]

      left_pct <- 
        (X - hover$domain$left) / (hover$domain$right - hover$domain$left)

      top_pct <- 
        (hover$domain$top - Y) / (hover$domain$top - hover$domain$bottom)  

      left_px <- 
        (hover$range$left + left_pct * (hover$range$right - hover$range$left)) / 
        hover$img_css_ratio$x 

      top_px <- 
        (hover$range$top + top_pct * (hover$range$bottom - hover$range$top)) / 
        hover$img_css_ratio$y 

      list(top = top_px, left = left_px)
    })




    observeEvent(hoverPos(), {
      req(hoverPos())
      hover <- hoverPos()
      if(is.null(hover)) return(NULL)

      #width per plot = 1000 / nr of cols
      #height per plot = 600 / nr of rows
      offX <- if(hover$left  > 250) {1000} else {30} # 270 = 540/2 (540 is the width of FP1PlotDoubleplot)
      offY <- if(hover$top  > 150) {1000} else {50}



      runjs(paste0( "$('[id=FP1PlotMultiplot]').off('mousemove.x').on('mousemove.x', function(e) {",
                    "  $('#my_tooltip').show();",
                    "  var tooltip = document.getElementById('my_tooltip');",
                    "  var rect = tooltip.getBoundingClientRect();",
                    "  var hoverLeft = ", hover$left, ";",
                    "  var hoverTop = ", hover$top, ";",
                    "  var imgWidth = e.target.width;",
                    "  var imgHeight = e.target.height;",
                    "  var offX = 2*hoverLeft > imgWidth ? -rect.width : 0;",
                    "  var offY = 2*hoverTop > imgHeight ? -rect.height+30 : 30;",
                    "  var shiftY = e.offsetY + offY;",
                    "  shiftY = shiftY + rect.height > imgHeight ? 20 + imgHeight - rect.height : shiftY;",
                    "  shiftY = Math.max(20, shiftY);",
                    "  $('#my_tooltip').css({",
                    "    top: shiftY + 'px',",
                    "    left: e.offsetX + e.target.offsetLeft + offX + 'px'",
                    "  });",
                    "});") )

      })

    output$GGHoverTable <- DT::renderDataTable({  

      df <- hoverData()
      if(!is.null(df)) {
        if(nrow(df)){
          df <- df[1,]
          DT::datatable(t(df), colnames = rep("", nrow(df)),
                        options = list(dom='t',ordering=F))
        }
      }
    })


    output$my_tooltip <- renderUI({
      req(hoverData())
      req(nrow(hoverData())>0 )
      wellPanel(
        DT::dataTableOutput('GGHoverTable'),
        style = 'background-color: #FFFFFFE6;padding:10px; width:400px;border-color:#339fff; width:auto')  
    })  

  }

  shinyApp(ui, server)

Answer 1

OK, I managed to get it working with some more modification: It now includes an if statement to check if the result doesn't cause coordinates for the anchor point to be either <0 or >object height

The only thing I would still want to change (if possible is the references to FP1PlotMultiplot inside the javascript because I want to apply this script to 7 different objects where their names are only listed in the first line of the javascript like this:

$('[id=FP1PlotMultiplot], [id=FP2PlotMultiplot],[id=CRFPlotMultiplot]').off('mousemove.x').on('mousemove.x', ......

so, to replace the name based approach by something similar to 'e.target' but then for the main output object's ID

  runjs(paste0( "$('[id=FP1PlotMultiplot]').off('mousemove.x').on('mousemove.x', function(e) {",
                  "  $('#my_tooltip').show();",
                  "  var tooltip = document.getElementById('my_tooltip');",
                  "  var rect = tooltip.getBoundingClientRect();",
                  "  var FrameID = document.getElementById('FP1PlotMultiplot');",
                  "  var frame = FrameID.getBoundingClientRect();",
                  "  var hoverLeft = ", hover$left, ";",
                  "  var hoverTop = ", hover$top, ";", 
                  "  var imgWidth = e.target.width;",
                  "  var imgHeight = e.target.height;",
                  "  var offX = 2 * hoverLeft > imgWidth ? -rect.width -10 : 10;",
                  "  var offY = 2 * hoverTop > imgHeight ? -rect.height + 10 : 10;",
                  "  var shiftY = e.offsetY + e.target.offsetTop + offY;",
                  "  if (offY === 10) {",
                  "  shiftY = shiftY + rect.height > frame.height ? -rect.height + 10 + e.offsetY + e.target.offsetTop : shiftY",
                  "  } else {",
                  "  shiftY = shiftY < 0 ? e.offsetY + e.target.offsetTop + 10 : shiftY",
                  "  };",
                  "  $('#my_tooltip').css({",
                  "    top: shiftY + 'px',",
                  "    left: e.offsetX + e.target.offsetLeft + offX + 'px'",
                  "  });",
                  "});") )