Updating CSS and rendering tooltip on hover over ggplot happening in the wrong order

不打扰是莪最后的温柔 提交于 2019-12-10 22:26:17

问题


I have constructed a dummy app here that produces hover messages for ggplot, and to make sure they stay within the screen boundaries, I wrote some calculations to determine the needed css corrections and send those to the server.

It is based on the first attempt to keep hover messages in place here: SOquestion Since then I have changed to sending modified css code to alter the offset of the tooltip.

The problem is however, it seems, that the table is build before the the css is send to the server, and I can't seem to find a way to change the order in which these two things happen.

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

ui <- pageWithSidebar(

  headerPanel("Hover off the page"),
  sidebarPanel(width = 2
  ),
  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
                 }
                 ')
    ),

    plotOutput('FP1Plot1' ,
               width = 1000,
               height = 800,
               hover = hoverOpts(id = 'FP1Plot_1_hover', delay = 0)          
    ),

    uiOutput("my_tooltip"),

    style = 'width:1250px'
      )
    )

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

  # ranges <- reactiveValues()


  output$FP1Plot1 <- renderPlot({
    ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() #+
      # coord_cartesian(xlim = ranges[[paste('FP1Plot1',  'x', sep = '')]], 
      #                 ylim = ranges[[paste('FP1Plot1',  'y', sep = '')]]
      # )          
  })




  # turn the hovers into 1 single reactive containing the needed information
  hoverReact <- reactive({
    ## in my real app I observer hover of all sub plots of all stages (7 pages with a multilot object)
    ## followed by code to store the page ID and plot NR as elements in hoverReact()
    hover <-  input[['FP1Plot_1_hover']]

    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)


    offX <- if(hover$left  > 350) {-400} else {30}
    offY <- if(hover$top  > 350) {-290} else {10 }

print('sending css') 
print(offY)

    runjs(paste0( "$(document).ready(function() {",
                  "setTimeout(function(){",
                         "$('[id^=FP1Plot]').mousemove(function(e) {",
                         "$('#my_tooltip').show();",         
                         "$('#my_tooltip').css({",         
                         "top: (e.offsetY +", offY, " ) + 'px',",
                         "left: (e.offsetX +", offX, ") + 'px'",     
                         "});",     
                         "});",     
                         "})});") )


}, priority = -1)


  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, autowidth = T))
      }
    }
  })


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

    })


}

shinyApp(ui, server)

来源:https://stackoverflow.com/questions/57066720/updating-css-and-rendering-tooltip-on-hover-over-ggplot-happening-in-the-wrong-o

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!