Question

您好，感谢您的提前帮助。

我正在为EDA开发Shiny应用程序，并希望将悬浮工具提示添加到ggplot散点图。

This example可以正常工作，直到轴被对数转换为止，因为工具提示坐标超出了绘图范围。

此答案中的

Example 3适用于对数转换的散点图，但是当我在Shiny模块中使用它时，tags$style和tags$script元素不会传递到工具提示UI对象{ {1}}和工具提示中的实际文本。我的怀疑是，在my_tooltip中引用了my_tooltip时，命名空间被遗漏了，所以tags$style从未使用HTML元素。

我不知道足够的HTML来编辑示例3。下面，我提供了三个可重现的示例，这些示例是从上面引用的两个来源修改而来的，所有这些都完成了我想实现的目标。任何帮助将不胜感激。谢谢。

可重现的示例1：适用于对数刻度，但不适用于Shiny模块

my_tooltip

可重现的示例2：无需转换即可工作，但工具提示因对数转换而超出范围

library(shiny)
library(ggplot2)

ui <- fluidPage(

  selectInput("logX", "Log scale",
              choices=coordoptions,
              selected="identity"),
  selectInput("logY", "Log scale",
              choices=coordoptions,
              selected="identity"),

  tags$head(tags$style('
                       #my_tooltip {
                       position: absolute;
                       width: 300px;
                       z-index: 100;
                       padding: 0;
                       }
                       ')),

  tags$script('
              $(document).ready(function() {
              // id of the plot
              $("#distPlot").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(iris)),
  plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0),
  uiOutput("my_tooltip")

  )

server <- function(input, output) {

      output$distPlot <- renderPlot({
    req(input$var_y)
    ggplot(iris, aes_string("Sepal.Width", input$var_y)) + 
      geom_point() +
      scale_x_continuous(trans=input$logX) + 
      scale_y_continuous(trans=input$logY) 
  })

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

  output$vals <- renderPrint({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover)[input$var_y]
    req(nrow(y) != 0)
    y
  })  
}

shinyApp(ui = ui, server = server)

可重现的示例3：可用于对数刻度并在模块中使用，但是library("shiny") library("ggplot2") ui <- pageWithSidebar( headerPanel("Tooltips in ggplot2 + shiny"), sidebarPanel( selectInput("logX", "Log scale", choices=coordoptions, selected="identity"), selectInput("logY", "Log scale", choices=coordoptions, selected="identity"), width = 3 ), mainPanel( # this is an extra div used ONLY to create positioned ancestor for tooltip # we don't change its position div( style = "position:relative", plotOutput("scatterplot", hover = hoverOpts("plot_hover", delay = 100, delayType = "debounce")), uiOutput("hover_info") ), width = 7 ) ) server <- function(input, output) { output$scatterplot <- renderPlot({ ggplot(mtcars, aes(x = mpg, y = hp)) + geom_point() + scale_x_continuous(trans=input$logX) + scale_y_continuous(trans=input$logY) }) output$hover_info <- renderUI({ hover <- input$plot_hover point <- nearPoints(mtcars, 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(" Car: ", rownames(point), " ", " mpg: ", point$mpg, " ", " hp: ", point$hp, " ", " Distance from left: ", left_px, ", from top: ", top_px))) ) }) } runApp(list(ui = ui, server = server))对`tags$style`不起作用（不在图上浮动）

my_tooltip

Answer 1

我没有设法重现您的示例，但这应该可行：

tags$style(
    paste0("#",
        ns(my_tooltip),
        "{
          position: absolute;
          width: 300px;
          z-index: 100;
          padding: 0;
         }"
    )
)

因此，基本上，您是在让HTML代码知道ns函数已分配的命名空间

您可以在此answer

中查看类似的示例

模块化闪亮：HTML样式标签不适用于命名空间工具提示

可重现的示例1：适用于对数刻度，但不适用于Shiny模块

可重现的示例2：无需转换即可工作，但工具提示因对数转换而超出范围

1 个答案: