0

I'm trying to build a hover functionality for my plots based on code found here: SO question in solution 3

hover functionality has been altered in ggplot2 though, but when I change

plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0),

to

plotOutput("distPlot", hoverOpts(id = "plot_hover", delay = 0),

the hover doesn't work half the time (until I click somewhere it seems. Am I missing something here?

Also tried to add delayType argument, but doesn't seem to help.

library(shiny)
library(ggplot2)

ui <- fluidPage(

    tags$head(tags$style('
     #my_tooltip {
      position: absolute;
      width: 300px;
      z-index: 100;
      padding: 0;
     }
  ')),

    tags$script('
    $(document).ready(function() {
      // id of the plot
      $("#distPlot").mousemove(function(e) { 

        // ID of uiOutput
        $("#my_tooltip").show();         
        $("#my_tooltip").css({             
          top: (e.pageY + 5) + "px",             
          left: (e.pageX + 5) + "px"         
        });     
      });     
    });
  '),

    selectInput("var_y", "Y-Axis", choices = names(iris)),
    plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0), ## issue is here
    uiOutput("my_tooltip")


)

server <- function(input, output) {


    output$distPlot <- renderPlot({
        req(input$var_y)
        ggplot(iris, aes_string("Sepal.Width", input$var_y)) + 
            geom_point()
    })

    output$my_tooltip <- renderUI({
        hover <- input$plot_hover 
        y <- nearPoints(iris, input$plot_hover)[input$var_y]
        req(nrow(y) != 0)
        wellPanel(dataTableOutput("vals"), style = 'background-color:#fff; padding:10px; width:400px;border-color:#339fff')
    })

    output$vals <- renderDataTable({
        hover <- input$plot_hover 
        y <- t(nearPoints(iris, input$plot_hover))
        req(nrow(y) != 0)
        DT::datatable(y, colnames = rep("", ncol(y)), options = list(dom = '', searching = F, bSort = FALSE))
    })  
}
shinyApp(ui = ui, server = server)
Mark
  • 2,789
  • 1
  • 26
  • 66
  • I always get an empty tooltip with your code. It works when I replace `dataTableOutput` with `DT::dataTableOutput`, `renderDataTable` with `DT::renderDataTable`, `y <- t(nearPoints(iris, input$plot_hover))` with `y <- nearPoints(iris, input$plot_hover)` (why do you use `t`?), `dom = ''` with `dom = 't'`, and I do `plotOutput("distPlot", hover = hoverOpts(id = "plot_hover", delay = 0))`. – Stéphane Laurent Apr 29 '19 at 08:09
  • Ah ok I understand why you use `t`, but then you should do `y <- nearPoints(iris, input$plot_hover)`, `req(nrow(y)) != 0` and `datatable(t(y), ......)`. – Stéphane Laurent Apr 29 '19 at 08:23
  • Ah yes, that does the trick. I noticed that I had some conflict with another app as well that ended after I restarted R. Must be another package interfering indeed. I'll edit my other question as well with these modifications – Mark Apr 29 '19 at 08:29
  • what is the motivation for doing the transpose inside the `datatable()` function? – Mark Apr 29 '19 at 08:32
  • If you transpose then `nrow(y)` is always `5`. – Stéphane Laurent Apr 29 '19 at 08:36
  • ah yes but that is only true for dummy data iris. – Mark Apr 29 '19 at 08:39
  • If you transpose then `nrow(y)` is never zero, whatever the dataframe. It is always equal to the number of columns of the dataframe. – Stéphane Laurent Apr 30 '19 at 08:21
  • yes very true of course. @Stephane, i'm trying to now add some javascript to plotOutput but i'm stuck. If you could have a look at https://stackoverflow.com/questions/55894314/how-to-add-custom-hover-function-to-plotoutput-so-it-can-be-used-for-many-plots I would much appreciate your input – Mark Apr 30 '19 at 16:28

1 Answers1

1

working version with modifications from the comments:

library(shiny)
library(ggplot2)

ui <- fluidPage(

  tags$head(tags$style('
     #my_tooltip {
      position: absolute;
      width: 300px;
      z-index: 100;
      padding: 0;
     }
  ')),

  tags$script('
    $(document).ready(function() {
      // id of the plot
      $("#distPlot").mousemove(function(e) { 

        // ID of uiOutput
        $("#my_tooltip").show();         
        $("#my_tooltip").css({             
          top: (e.pageY + 5) + "px",             
          left: (e.pageX + 5) + "px"         
        });     
      });     
    });
  '),

  selectInput("var_y", "Y-Axis", choices = names(iris)),
  plotOutput("distPlot", hover = hoverOpts(id = "plot_hover", delay = 0)),
  uiOutput("my_tooltip")


)

server <- function(input, output) {


  output$distPlot <- renderPlot({
    req(input$var_y)
    ggplot(iris, aes_string("Sepal.Width", input$var_y)) + 
      geom_point()
  })

  output$my_tooltip <- renderUI({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover)
    req(nrow(y) != 0)
    wellPanel(DT::dataTableOutput("vals"), style = 'background-color:#fff; padding:10px; width:400px;border-color:#339fff')
  })

  output$vals <- DT::renderDataTable({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover)
    req(nrow(y)) != 0
    DT::datatable(t(y), colnames = rep("", ncol(t(y))), options = list(dom = 't', searching = F, bSort = FALSE))
  })  
}
shinyApp(ui = ui, server = server)
Mark
  • 2,789
  • 1
  • 26
  • 66