実装

library(shiny)
library(ggplot2)

ui = fluidPage(
  "Motor cars",
  tags$div(
    plotOutput("plot", hover = "hover"),
    htmlOutput("tooltip"),
    style = "position: relative;"
  )
)

server = function(input, output, session) {
  output$plot <- renderPlot(qplot(wt, mpg, data = mtcars))
  
  output$tooltip <- renderText({
    req(input$hover)
    coords <- signif(c(input$hover$x, input$hover$y))
    htmltools::renderTags(
      tags$div(
        "x:", coords[1L], tags$br(),
        "y:", coords[2L],
        style = paste0(
          "position: absolute; ",
          "top: ", input$hover$coords_css$y + 5, "px; ",
          "left: ", input$hover$coords_css$x + 5, "px; ",
          "background: gray; ",
          "padding: 3px; ",
          "color: white; "
        )
      )
    )$html
  })

}

runGadget(ui, server)

解説: UI

List of 9
 $ x            : num 1.57
 $ y            : num 13.2
 $ coords_css   :List of 2
  ..$ x: int 86
  ..$ y: int 286
 $ coords_img   :List of 2
  ..$ x: int 86
  ..$ y: int 286
 $ img_css_ratio:List of 2
  ..$ x: int 1
  ..$ y: int 1
 $ mapping      : Named list()
 $ domain       :List of 4
  ..$ left  : num 1.36
  ..$ right : num 5.58
  ..$ bottom: num 9.46
  ..$ top   : num 34.8
 $ range        :List of 4
  ..$ left  : num 59
  ..$ right : num 589
  ..$ bottom: num 326
  ..$ top   : num 58
 $ log          :List of 2
  ..$ x: NULL
  ..$ y: NULL

runGadget(
  fluidPage(
    plotOutput("plot", hover = "hover"),
    verbatimTextOutput("hover")
  ),
  function(input, output, session) {
    output$plot <- renderPlot(plot(mtcars$wt, mtcars$mpg))
    output$hover <- renderPrint(str(input$hover))
  }
)

ui = fluidPage(
  "Motor cars",
  tags$div(
    plotOutput(
      "plot",
      hover = hoverOpts(
        "hover", clip = FALSE, nullOutside = FALSE
      )
    ),
    htmlOutput("tooltip"),
    style = "position: relative;"
  )
)

解説: Server

プロットはいつも通り．

output$plot <- renderPlot(qplot(wt, mpg, data = mtcars))

特殊なのはツールチップの作り方だろう．

output$tooltip <- renderText({
  req(input$hover)
  coords <- signif(c(input$hover$x, input$hover$y))
  htmltools::renderTags(
    tags$div(
      "x:", coords[1L], tags$br(),
      "y:", coords[2L],
      style = paste0(
        "position: absolute; ",
        "top: ", input$hover$coords_css$y + 5, "px; ",
        "left: ", input$hover$coords_css$x + 5, "px; ",
        "background: gray; ",
        "padding: 3px; ",
        "color: white; "
      )
    )
  )$html
})

まず，ツールチップの UI には htmlOutput を用いることにしたので，生な文字列を UI に送れるよう， renderText を使って文字列をレンダリングするようにする．

ただし，マウスがプロットの範囲外に存在しない時はレンダリングして欲しくない．このような時には req() を用いる． req() に指定した値が NULL や FALSE の時，Shiny は移行の行の実効を中止する．つまり req(input$hover) なら input$hover が NULL の時にレンダリングを中止してくれる．

そして req() を満たした時のコマンドを書いていく．

最終的には

<div position: absolute; top: 10px; left: 10px;> tooltip </div>

のような形を目指す．ごりごりと paste() していっても良いが楽したいので，tags$div() を使い，htmltools::renderTags() で HTML に変換するのがいいだろう．

ツールチップにただ tooltip と表示するのは面白くないので，マウス位置の座標を返すようにしてみる．

input$hover が返す座標はそのままでは桁数が多くで読み辛いので

coords <- signif(c(input$hover$x, input$hover$y))

しておくことがポイントだ．

CSS の top 属性と left 属性には input$hover$coords_css$y と input$hover$coords_css$x 由来の値を指定するが， + 5 などの値を足して，マウス位置からずらしておいてやることがポイント．これにより，マウスがツールチップに重んなってしまい

• 読み辛くなる
• input$hover が NULL になってしまってツールチップが消えてしまう

といった問題を回避できる．