悬停时将趋势线数据添加到 Shiny Plotly

Add trendline data to Shiny Plotly on hover

我正在使用 ggplotly() 创建一个图,我希望 Spearman 的等级相关性 [我在此处存储为反应值 rho] 悬停在创建的线上时出现geom_smooth。我在 python (https://plot.ly/python/linear-fits/) 中找到了一篇关于在 plotly 网站上执行此操作的文章,但我不确定如何在 R 中实现此目的。感谢任何帮助或线索!

library(shiny)
library(plotly)

ui <- fluidPage(
  mainPanel(plotlyOutput("line_plot"),
            verbatimTextOutput("rho"))
  )

# Define server logic required to draw a histogram
server <- function(input, output) {

  # calculate rho to be printed over line
  rho <- reactive({ cor.test(x = iris$Sepal.Length, y = iris$Sepal.Width, method='spearman')[[4]] })

  output$rho <- renderText(paste0("rho: ", rho()))

  output$line_plot <- renderPlotly({
    p <- ggplotly(
      ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
        geom_point() +
        # would I add the tooltip text here?
        # I know I need it to be:
        # "<b> rho: </b>", rho(), "<br/>",
        geom_smooth(method=lm, se=FALSE, color = "red") +
        theme_minimal()
    )
  })

}

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

可以添加非官方美学text:

library(shiny)
library(plotly)

ui <- fluidPage(
  mainPanel(plotlyOutput("line_plot"),
            verbatimTextOutput("rho"))
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  # calculate rho to be printed over line
  rho <- reactive({ cor.test(x = iris$Sepal.Length, y = iris$Sepal.Width, method='spearman')[[4]] })

  output$rho <- renderText(paste0("rho: ", rho()))

  output$line_plot <- renderPlotly({
    p <- ggplotly(
      ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
        geom_point() +
        geom_smooth(method=lm, se=FALSE, color = "red", aes(text = paste0("<b> rho: </b>", rho()))) +
        theme_minimal()
    ) 
  })

}

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