2016-09-06 53 views
0

我正在構建一個閃亮的Web應用程序,我需要在將鼠標懸停在它們上方時顯示情節點。我設法通過將我的數組的x,y和其他信息放置在一個固定的可拖動的absolutepane中來解決此問題。每次將鼠標懸停在指針附近的某個點上時,是否可以放置此面板?另外,如果鼠標沒有懸停在任何點上,我該如何隱藏面板? 目前,面板可拖動,並提前使用此代碼如何將光面板放在指針/鼠標附近?

ui <- shinyUI(fluidPage(  
    absolutePanel(fixed=TRUE, draggable = TRUE, 
       verbatimTextOutput("hover_info") 
), 
    plotOutput("myplot", 
      hover = hoverOpts(id ="myplot_hover") 
) 
)) 

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

    output$myplot <- renderPlot({ 
    ggplot(mtcars) + geom_point(aes(mpg,cyl)) 
          }) 

    output$hover_info <- renderPrint({ 
    nearPoints(mtcars, input$myplot_hover,maxpoints=1) 
            }) 
}) 

shinyApp(ui, server) 

由於在頁面的頂部固定

回答

0

這會工作:

require(shiny) 
require(ggplot2) 

ui <- shinyUI(fluidPage( 
    tags$head(
    tags$script(
     HTML(" 
      // Get mouse coordinates 
      var mouseX, mouseY; 
      $(document).mousemove(function(e) { 
       mouseX = e.pageX; 
       mouseY = e.pageY; 
      }).mouseover(); 

      // Function to possition draggable, place on current mouse coordinates 
      Shiny.addCustomMessageHandler ('placeDraggable',function (message) { 
        var element = $('#hover_info').parent(); 
        element.css({'top': mouseY + 'px', 'left' : mouseX + 'px'}) 
      }); 

      // Show or hide draggable 
      Shiny.addCustomMessageHandler ('hideDraggable',function (message) { 
      if(message.hide == true){ 
       $('#hover_info').parent().hide(); 
      } else{ 
       $('#hover_info').parent().show(); 
      } 
      }); 
      ") 
    ) 
), 
    absolutePanel(fixed=TRUE, draggable = TRUE, 
       verbatimTextOutput("hover_info") 
), 
    plotOutput("myplot", 
      hover = hoverOpts(id ="myplot_hover") 
) 
)) 

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

    output$myplot <- renderPlot({ 
    ggplot(mtcars) + geom_point(aes(mpg,cyl)) 
    }) 

    # Create reactive variable 
    points <- reactive({ 
    nearPoints(mtcars, input$myplot_hover,maxpoints=1) 
    }) 

    # Define helper function 
    hideTooltip <- function(hide){ 
    session$sendCustomMessage(type = 'hideDraggable', message = list('hide'=hide)) 
    } 

    observe({ 
    # Assign to local variable, not strictly necessary 
    p <- points() 

    if(nrow(p) == 0){ # Check if points is returning a point or empty data.frame 
     hideTooltip(TRUE) # Hide tooltip if there's no info to show 
     return() 
    } 

    hideTooltip(FALSE) # Show tooltip if a point is returned from nearPoints 
    session$sendCustomMessage(type = 'placeDraggable', message = list()) #Place draggable on current mouse position 
    output$hover_info <- renderPrint({p}) # Render Text 
    }) 

}) 

shinyApp(ui, server) 

在這裏,我簡單地把當觀察者被觸發並且返回一個點時,當前鼠標位置上的hover_info父div。

+0

哇,它像一個魅力。我需要研究你的代碼,但我現在就會使用它。非常感謝,真是太棒了。 – user2694433