Question

我正在构建一个闪亮的应用程序。

我正在使用ggplot绘制图表。

当我鼠标悬停在图表上的点时，我想要一个工具提示，显示数据框中的一列（可自定义的工具提示）

请你建议最好的前进方式。

简单的应用程序：

# ui.R

shinyUI(fluidPage(
 sidebarLayout(
    sidebarPanel(
        h4("TEst PLot")),
    mainPanel(
        plotOutput("plot1")
    )
)
))

# server.R

library(ggplot2)
data(mtcars)

shinyServer(
function(input, output) {
    output$plot1 <- renderPlot({
        p <- ggplot(data=mtcars,aes(x=mpg,y=disp,color=factor(cyl)))
        p <- p + geom_point()
        print(p)
    })
}
)

当我将鼠标悬停在点上时，我希望它显示mtcars $ wt

Answer 1

如果我正确理解了这个问题，可以通过最近更新ggplot2和基础包的闪亮包来实现。使用Winston Chang和Joe Cheng http://shiny.rstudio.com/gallery/plot-interaction-basic.html的这个例子，我能够解决这个问题。 Hover现在是plotOutput（）的输入参数，因此将其与verbatimTextOutput一起添加到ui，以显示悬停在其上的点的mtcars $ wt。

在服务器中，我基本上制作了一个距离向量，用于计算从鼠标到图中任意点的距离，如果该距离小于3（适用于此应用程序），则显示最近点的mtcars $ wt你的老鼠要清楚输入$ plot_hover返回有关鼠标位置的信息列表，在此示例中仅从输入$ plot_hover中提取x和y元素。

library(ggplot2)
library(Cairo)   # For nicer ggplot2 output when deployed on Linux

ui <- fluidPage(
    fluidRow(
        column(width = 12,
               plotOutput("plot1", height = 350,hover = hoverOpts(id ="plot_hover"))
        )
    ),
    fluidRow(
        column(width = 5,
               verbatimTextOutput("hover_info")
        )
    )
)

server <- function(input, output) {


    output$plot1 <- renderPlot({

        ggplot(mtcars, aes(x=mpg,y=disp,color=factor(cyl))) + geom_point()

    })

    output$hover_info <- renderPrint({
        if(!is.null(input$plot_hover)){
            hover=input$plot_hover
            dist=sqrt((hover$x-mtcars$mpg)^2+(hover$y-mtcars$disp)^2)
            cat("Weight (lb/1000)\n")
            if(min(dist) < 3)
                mtcars$wt[which.min(dist)]
        }


    })
}
shinyApp(ui, server)

我希望这有帮助！

Answer 2

你也可以使用一点点JQuery和条件renderUI来显示指针附近的自定义工具提示。

library(shiny)
library(ggplot2)

ui <- fluidPage(

  tags$head(tags$style('
     #my_tooltip {
      position: absolute;
      width: 300px;
      z-index: 100;
     }
  ')),
  tags$script('
    $(document).ready(function(){
      // id of the plot
      $("#plot1").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(mtcars), selected = "disp"),
  plotOutput("plot1", hover = hoverOpts(id = "plot_hover", delay = 0)),
  uiOutput("my_tooltip")
)

server <- function(input, output) {

  data <- reactive({
    mtcars
  })

  output$plot1 <- renderPlot({
    req(input$var_y)
    ggplot(data(), aes_string("mpg", input$var_y)) + 
      geom_point(aes(color = factor(cyl)))
  })

  output$my_tooltip <- renderUI({
    hover <- input$plot_hover 
    y <- nearPoints(data(), input$plot_hover)[ ,c("mpg", input$var_y)]
    req(nrow(y) != 0)
    verbatimTextOutput("vals")
  })

  output$vals <- renderPrint({
    hover <- input$plot_hover 
    y <- nearPoints(data(), input$plot_hover)[ , c("mpg", input$var_y)]
    # y <- nearPoints(data(), input$plot_hover)["wt"]
    req(nrow(y) != 0)
    # y is a data frame and you can freely edit content of the tooltip 
    # with "paste" function 
    y
  })
}
shinyApp(ui = ui, server = server)

<强>编辑：

在这篇文章之后，我搜索了互联网，看看它是否可以做得更好，并为ggplot找到了this精彩的自定义工具提示。我相信它很难做得更好。

Answer 3

使用ggplot，您只需将ggplotly翻译成自己的互动版本即可。只需在ggplot对象上调用函数library(plotly) data(mtcars) shinyApp( ui <- shinyUI(fluidPage( sidebarLayout(sidebarPanel( h4("Test Plot")), mainPanel(plotlyOutput("plot1")) ) )), server <- shinyServer( function(input, output) { output$plot1 <- renderPlotly({ p <- ggplot(data=mtcars,aes(x=mpg,y=disp,color=factor(cyl))) p <- p + geom_point() ggplotly(p) }) } )) shinyApp(ui, server)：

innerHTML

对于工具提示中显示的内容的自定义，请查看例如here

Answer 4

我已经与同事一起发布了一个名为GGTips的软件包（不在CRAN上），该软件包可以在绘图中添加工具提示。我们创建了自己的解决方案，因为在使用与ggplot2不100％兼容的plotly重新创建复杂图时遇到了麻烦。 Git repo有一个在线演示的链接。

鼠标悬停在闪亮的ggplot上时的工具提示

4 个答案: