将鼠标悬停在 Plotly 中显示填充颜色而不是文本

问题描述 投票：0回答：1

我之前有 R Shiny 代码，其中关于 renderPlotly 图中的悬停文本，一切都按预期工作：

  1. 将鼠标悬停在各个散点上时会显示信息
  2. 彩色背景显示专门定义的自定义悬停文本

但是，当我将绘图移出到一个单独的函数时，这打破了上面的第 2 点。这是一个可重现的示例：

library(shiny)
library(plotly)
library(data.table)

# Create dummy data
set.seed(123)
create_dummy_data <- function(n = 50) {
  data.table(
    client_name = paste("Client", 1:n),
    assigned = sample(c("Dr. A", "Dr. B", "Dr. C"), n, replace = TRUE),
    T1 = runif(n, 0, 100),
    T2 = runif(n, 0, 100)
  )
}

# Plot generation function
generate_firstvlast_plot <- function(dat, is_administrator = FALSE) {
  minScore <- 0
  maxScore <- 100
  min_fvl_score <- 10
  
  upper_red <- data.frame(x=c(minScore,minScore,(maxScore-min_fvl_score)),y=c((minScore+min_fvl_score),maxScore, maxScore))
  lower_green <- data.frame(x=c((minScore+min_fvl_score),maxScore,maxScore),y=c(minScore,minScore,(maxScore-min_fvl_score)))
  middle_grey <- data.frame(x=c(minScore, minScore,(maxScore-min_fvl_score),maxScore, maxScore,(minScore+min_fvl_score)), 
                            y=c(minScore, (minScore+min_fvl_score),maxScore,maxScore,(maxScore-min_fvl_score),minScore))
  
  p <- plot_ly(height = 600) %>%
    config(displayModeBar = FALSE) %>%
    add_polygons(data = upper_red, x = ~x, y = ~y, fillcolor = "#ffa9a4", line = list(width = 0),
                 hoverinfo = "text", text = "Deteriorated") %>%
    add_polygons(data = lower_green, x = ~x, y = ~y, fillcolor = "#b9ffaf", line = list(width = 0),
                 hoverinfo = "text", text = "Significantly Improved") %>%
    add_polygons(data = middle_grey, x = ~x, y = ~y, fillcolor = "lightgray", line = list(width = 0),
                 hoverinfo = "text", text = "Little Change") %>%
    add_segments(x = minScore, xend = maxScore, y = minScore, yend = maxScore, 
                 line = list(color = "gray", width = 0.25, dash = "dot"), 
                 hoverinfo = "none") %>%
    layout(
      xaxis = list(title = "First Assessment", range = c(minScore, maxScore)),
      yaxis = list(title = "Last Assessment", range = c(minScore, maxScore)),
      showlegend = FALSE
    )
  
  if (is_administrator) {
    hover_text <- paste0(
      "<b>Client:</b> ", dat$client_name,
      "<br><b>First Score:</b> ", round(dat$T1, 1),
      "<br><b>Last Score:</b> ", round(dat$T2, 1),
      "<br><b>Practitioner:</b> ", dat$assigned)
  } else {
    hover_text <- paste0(
      "<b>Client:</b> ", dat$client_name,
      "<br><b>First Score:</b> ", round(dat$T1, 1),
      "<br><b>Last Score:</b> ", round(dat$T2, 1))
  }
  
  p <- p %>%
    add_markers(data = dat, x = ~jitter(T1), y = ~T2, 
                marker = list(size = 6, color = "#3279b7"), 
                hoverinfo = "text", text = hover_text)
  
  # This used to work when it was not done as a function:
  # p$x$data[[1]]$text <- "Deteriorated"
  # p$x$data[[2]]$text <- "Significantly Improved"
  # p$x$data[[3]]$text <- "Little Change"
  
  return(p)
}

# Shiny app
ui <- fluidPage(
  titlePanel("First vs Last Assessment Plot"),
  sidebarLayout(
    sidebarPanel(
      checkboxInput("is_admin", "Administrator View", FALSE)
    ),
    mainPanel(
      plotlyOutput("firstvlast_plot")
    )
  )
)

server <- function(input, output, session) {
  dummy_data <- reactive({
    create_dummy_data()
  })
  
  output$firstvlast_plot <- renderPlotly({
    generate_firstvlast_plot(dummy_data(), input$is_admin)
  })
}

shinyApp(ui, server)

这个注释掉的部分修改了彩色背景上的悬停文本，效果非常好。但是，当创建为函数时（使用上述代码），我收到下标越界错误，因为 p$x$data 似乎不再存在。相反，悬停仅显示颜色（十六进制代码或“浅灰色”）。我尝试在 add_polygons 中添加：hoverinfo =“text”，text =“Deteriorated”，但这没有什么区别。

有人对在 R Shiny 中运行的绘图（作为函数）以及如何修改颜色（即背景）悬停文本有任何想法吗？

r shiny plotly
1个回答
0
投票

您必须先构建绘图对象，然后才能修改其数据（请参阅下面的 

plotly_build
调用）：

library(shiny)
library(plotly)
library(data.table)

# Create dummy data
set.seed(123)
create_dummy_data <- function(n = 50) {
  data.table(
    client_name = paste("Client", 1:n),
    assigned = sample(c("Dr. A", "Dr. B", "Dr. C"), n, replace = TRUE),
    T1 = runif(n, 0, 100),
    T2 = runif(n, 0, 100)
  )
}

# Plot generation function
generate_firstvlast_plot <- function(dat, is_administrator = FALSE) {
  minScore <- 0
  maxScore <- 100
  min_fvl_score <- 10
  
  upper_red <- data.frame(x=c(minScore,minScore,(maxScore-min_fvl_score)),y=c((minScore+min_fvl_score),maxScore, maxScore))
  lower_green <- data.frame(x=c((minScore+min_fvl_score),maxScore,maxScore),y=c(minScore,minScore,(maxScore-min_fvl_score)))
  middle_grey <- data.frame(x=c(minScore, minScore,(maxScore-min_fvl_score),maxScore, maxScore,(minScore+min_fvl_score)), 
                            y=c(minScore, (minScore+min_fvl_score),maxScore,maxScore,(maxScore-min_fvl_score),minScore))
  
  p <- plot_ly(height = 600) %>%
    config(displayModeBar = FALSE) %>%
    add_polygons(data = upper_red, x = ~x, y = ~y, fillcolor = "#ffa9a4", line = list(width = 0),
                 hoverinfo = "text", text = "Deteriorated") %>%
    add_polygons(data = lower_green, x = ~x, y = ~y, fillcolor = "#b9ffaf", line = list(width = 0),
                 hoverinfo = "text", text = "Significantly Improved") %>%
    add_polygons(data = middle_grey, x = ~x, y = ~y, fillcolor = "lightgray", line = list(width = 0),
                 hoverinfo = "text", text = "Little Change") %>%
    add_segments(x = minScore, xend = maxScore, y = minScore, yend = maxScore, 
                 line = list(color = "gray", width = 0.25, dash = "dot"), 
                 hoverinfo = "none") %>%
    layout(
      xaxis = list(title = "First Assessment", range = c(minScore, maxScore)),
      yaxis = list(title = "Last Assessment", range = c(minScore, maxScore)),
      showlegend = FALSE
    )
  
  if (is_administrator) {
    hover_text <- paste0(
      "<b>Client:</b> ", dat$client_name,
      "<br><b>First Score:</b> ", round(dat$T1, 1),
      "<br><b>Last Score:</b> ", round(dat$T2, 1),
      "<br><b>Practitioner:</b> ", dat$assigned)
  } else {
    hover_text <- paste0(
      "<b>Client:</b> ", dat$client_name,
      "<br><b>First Score:</b> ", round(dat$T1, 1),
      "<br><b>Last Score:</b> ", round(dat$T2, 1))
  }
  
  p <- p %>%
    add_markers(data = dat, x = ~jitter(T1), y = ~T2, 
                marker = list(size = 6, color = "#3279b7"), 
                hoverinfo = "text", text = hover_text)
  
  p <- plotly_build(p)
  p$x$data[[1]]$text <- "Deteriorated"
  p$x$data[[2]]$text <- "Significantly Improved"
  p$x$data[[3]]$text <- "Little Change"
  
  return(p)
}

# Shiny app
ui <- fluidPage(
  titlePanel("First vs Last Assessment Plot"),
  sidebarLayout(
    sidebarPanel(
      checkboxInput("is_admin", "Administrator View", FALSE)
    ),
    mainPanel(
      plotlyOutput("firstvlast_plot")
    )
  )
)

server <- function(input, output, session) {
  dummy_data <- reactive({
    create_dummy_data()
  })
  
  output$firstvlast_plot <- renderPlotly({
    generate_firstvlast_plot(dummy_data(), input$is_admin)
  })
}

shinyApp(ui, server)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.