Question

我正在构建一个闪亮的webapp，我需要在悬停在它们上方时显示绘图点。我设法通过将我的数组的x，y和其他信息放在一个固定的可拖动的绝对窗格中来解决这个问题。每当鼠标悬停在指针附近的某个点上时，有没有办法放置此面板？另外，如果鼠标没有悬停在任何一点，我怎么能隐藏面板呢？目前，该面板是可拖动的，并使用此代码

固定在页面顶部

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)

提前致谢

Answer 1

这样可行：

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放在当前鼠标位置上。

Answer 2

我认为可以简化这一点。在这里，我使用的是点击而不是悬停，但这可以根据当然的味道进行更改。

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 position draggable, place on current mouse coordinates
           Shiny.addCustomMessageHandler ('placeDraggable',function (message) {
           var element = $('#click_info').parent();
           element.css({'top': mouseY + 'px', 'left' : mouseX + 'px'})
           });
           ")
    )
  ),
  absolutePanel(fixed=TRUE, draggable = TRUE, uiOutput("click_info")),
  plotOutput("myplot", click = clickOpts(id ="myplot_click"))
))

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

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

  show_this  = reactiveVal(NULL)
  print_this = reactiveVal(NULL)
  observeEvent(input$myplot_click, {
    p <- nearPoints(mtcars, input$myplot_click, maxpoints=1)
    if( nrow(p) == 0 ) {
      show_this(NULL)
    }
    else {
      session$sendCustomMessage(type = 'placeDraggable', message = list())
      show_this(tagList(
        { actionButton("input_button","OK") },
        { br() },
        { verbatimTextOutput("point_info") }
      )
      )
      print_this({p})
    }
  })
  output$click_info <- renderUI   (show_this() )
  output$point_info <- renderPrint(print_this())

  observeEvent(input$input_button,{
    if (input$input_button) { show_this(NULL) }
  })

})

shinyApp(ui, server)

如您所见，整个hideDraggable是不必要的，以及辅助函数和points（）。并且输出现在在观察者之外，这是推荐的。

如果您了解一点JavaScript（我不知道!!!），也可以删除placeDraggable函数，并指定#click_info元素应始终根据鼠标坐标放置。闪亮的代码确保它只在您希望它显示时显示。

在这里，我还添加了一个带有显示文本的小按钮，以表明您可以将此作为一个机会，以便在需要时从用户那里获得更多输入。（显然，你需要比OK按钮更丰富的信息。例如，你可以用它来消除这一点。）

如何在指针/鼠标附近放置闪亮的面板？

2 个答案: