更新CSS和渲染工具提示以错误的顺序将鼠标悬停在ggplot上

时间:2019-07-16 23:35:54

标签: css r ggplot2 shinydashboard

我在这里构建了一个虚拟应用程序,该应用程序为ggplot生成悬停消息,并确保它们停留在屏幕边界内,我编写了一些计算以确定所需的CSS校正并将其发送到服务器。

它基于以下第一次尝试将悬停消息保留在适当位置:SOquestion 从那时起,我更改为发送修改后的CSS代码来更改工具提示的偏移量。

但是,问题似乎是,表是在将CSS发送到服务器之前构建的,我似乎无法找到一种方法来更改这两件事发生的顺序。

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)

0 个答案:

没有答案