不幸的是，ggplot 不是交互式的，但可以使用 plotly 包轻松“修复”。您只需将plotOutput 替换为plotlyOutput，然后使用renderPlotly 进行绘图。
示例 1：情节
library(shiny)
library(ggplot2)
library(plotly)
ui <- fluidPage(
plotlyOutput("distPlot")
)
server <- function(input, output) {
output$distPlot <- renderPlotly({
ggplot(iris, aes(Sepal.Width, Petal.Width)) +
geom_line() +
geom_point()
})
}
shinyApp(ui = ui, server = server)
示例 2：plotOutput(..., hover = "plot_hover")：
尽管如此，我们不必使用任何特殊的包来将交互性引入我们的图表。我们需要的只是我们可爱闪亮的shiny！我们可以使用plotOutput 选项，例如click、hover 或dblclick 来使情节具有交互性。 (See more examples in shiny gallery)
在下面的示例中，我们通过 hover = "plot_hover" 添加“悬停”，然后指定默认为 300 毫秒的延迟。
plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0)
然后我们可以通过input$plot_hover 访问值并使用函数nearPoints 来显示点附近的值。
ui <- fluidPage(
selectInput("var_y", "Y-Axis", choices = names(iris)),
plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0),
uiOutput("dynamic")
)
server <- function(input, output) {
output$distPlot <- renderPlot({
req(input$var_y)
ggplot(iris, aes_string("Sepal.Width", input$var_y)) +
geom_point()
})
output$dynamic <- renderUI({
req(input$plot_hover)
verbatimTextOutput("vals")
})
output$vals <- renderPrint({
hover <- input$plot_hover
# print(str(hover)) # list
y <- nearPoints(iris, input$plot_hover)[input$var_y]
req(nrow(y) != 0)
y
})
}
shinyApp(ui = ui, server = server)
示例 3：自定义 ggplot2 工具提示：
第二种解决方案效果很好，但是是的……我们希望做得更好！是的……我们可以做得更好！ （...如果我们使用一些 javaScript 但 pssssss 不要告诉任何人！）。
library(shiny)
library(ggplot2)
ui <- fluidPage(
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()
})
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)
示例 4：ggvis 和 add_tooltip：
我们也可以使用ggvis 包。这个包很棒，但是还不够成熟。
更新：ggvis目前处于休眠状态：https://github.com/rstudio/ggvis#status
library(ggvis)
ui <- fluidPage(
ggvisOutput("plot")
)
server <- function(input, output) {
iris %>%
ggvis(~Sepal.Width, ~Petal.Width) %>%
layer_points() %>%
layer_lines() %>%
add_tooltip(function(df) { paste0("Petal.Width: ", df$Petal.Width) }) %>%
bind_shiny("plot")
}
shinyApp(ui = ui, server = server)
已编辑
示例 5：
在这篇文章之后，我搜索了互联网，看看它是否可以比示例 3 做得更好。我为 ggplot 找到了 this 很棒的自定义工具提示，我相信它几乎没有比这更好的了。