使用geom_polygon（）+ coord_map（）在ggplot中自定义工具提示

Question

I am following the example here to create custom tooltips for my ggplot object. I don't want to use plotly because of how it renders in shiny.

I have it producing the tooltips with the content I want, but it is not returning the correct nearPoint. I noticed that coord_map("polyconic") makes the distortion worse, but the distortion still exists with coord_map()

Here is a minimally reproducible example of what I'm working on (most is taken from the above link):

library(ggplot2)
library(mapdata)

map.county <- map_data('county')
counties<- data.table(map.county)

library(shiny)

ui <- fluidPage(

   # Application title
   titlePanel("NearPoints using a map"),
   div(
     style = "position:relative",
     plotOutput("county_map", 
                hover = hoverOpts("plot_hover", delay = 100, delayType = "debounce")),
     uiOutput("hover_info")
   )
)

server <- function(input, output) {

  output$county_map<- renderPlot({
    ggplot(counties, aes(x=long, y=lat, group = group)) +
      geom_polygon(colour = "grey") +
      coord_map("polyconic" )  #causes the tooltips to be even more off
  })

  output$hover_info<-renderUI({
    hover <- input$plot_hover
    point <- nearPoints(counties, hover, threshold = 5, maxpoints = 1, addDist = TRUE)
    if (nrow(point) == 0) return(NULL)

    # calculate point position INSIDE the image as percent of total dimensions
    # from left (horizontal) and from top (vertical)
    left_pct <- (hover$x - hover$domain$left) / (hover$domain$right - hover$domain$left)
    top_pct <- (hover$domain$top - hover$y) / (hover$domain$top - hover$domain$bottom)

    # calculate distance from left and bottom side of the picture in pixels
    left_px <- hover$range$left + left_pct * (hover$range$right - hover$range$left)
    top_px <- hover$range$top + top_pct * (hover$range$bottom - hover$range$top)

    # create style property fot tooltip
    # background color is set so tooltip is a bit transparent
    # z-index is set so we are sure are tooltip will be on top
    style <- paste0("position:absolute; z-index:100; background-color: rgba(245, 245, 245, 0.85); ",
                    "left:", left_px + 2, "px; top:", top_px + 2, "px;")

    # actual tooltip created as wellPanel
    wellPanel(
      style = style,
      p(HTML(paste0("<b></b>", point$region, "<br/>",
                    "<b>County: </b>", point$subregion, "<br/>",
                    "<b> Distance from left: </b>", left_px, "<b>, from top: </b>", top_px)))
    )
  })

}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

I ditched the nearPoints package and instead am using ggiraph as recommended by Matt.

Here is my solution to my example above:

library(ggplot2)
library(mapdata)
library(shiny)

map.county <- map_data('county')
counties<- data.table(map.county)

ui <- fluidPage(

  # Application title
  titlePanel("NearPoints using a map"),
fluidRow(column(12,
                ggiraph::ggiraphOutput("county_map")))
)

server <- function(input, output) {

  output$county_map<- renderggiraph({
   p<- ggplot(counties, aes(x=long, y=lat, group = group)) +
      coord_map("polyconic" ) +
      geom_polygon_interactive(aes(tooltip = county))

    ggiraph(code = print(p))
  })

}

# Run the application 
shinyApp(ui = ui, server = server)