在 R Shiny 中，我想向绘图添加文本注释，而不必重新绘制整个图表。将plotlyProxy 和plotlyproxyInvoke 与relayout 参数一起使用似乎是正确的方法，但我无法让它工作。
按下操作按钮时，会生成多个角色的高度与体重图表。然后，我想使用 selectizeinput 选择多个字符名称，并在图中注释它们的相应点。不幸的是，当我做出选择时，没有出现任何文本注释。
在下面的可重现示例中，重绘整个图表就可以了，因为只有几个点，但我的实际数据集有数千个点，所以如果可能的话，我希望能够在不重绘的情况下进行注释。
这是可重现的示例:
library(shiny)
library(shinyjs)
library(plotly)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(inputId = "Race", label = "Race", choices = c("Humans", "Goblins"), selected = "Humans"),
actionButton(inputId = "Go", label = "Plot")
),
mainPanel(
plotlyOutput(outputId = "Height_Weight_plot"),
selectizeInput(inputId = "Names", label = "Search for characters", choices = NULL, multiple = TRUE)
)
)
)
server <- function(input, output, session) {
character_data <- eventReactive(input$Go,{
if(input$Race == "Humans"){
data.frame(
Name = c("Arthur", "Rodrick", "Elaine", "Katherine", "Gunther", "Samuel", "Marcus", "Selene"),
Role = c("Nobleman", "Soldier", "Soldier", "Priestess", "Mage", "Squire", "Merchant", "Witch"),
Sex = c("M", "M", "F", "F", "M", "M", "M", "F"),
Age = c(39, 41, 29, 46, 55, 17, 42, 40),
Height = c(6.00, 5.10, 5.80, 5.20, 6.30, 5.10, 5.40, 6.20),
Weight = c(160, 165, 154, 129, 171, 144, 131, 144)
)
}else if(input$Race == "Goblins"){
data.frame(
Name = c("Grog", "Dirk", "Kane", "Yilde", "Moldred", "Vizir", "Igret", "Baelon"),
Role = c("Pirate", "Pirate", "Pirate", "Bandit", "Merchant", "Bandit", "Merchant", "Shaman"),
Sex = c("M", "M", "M", "F", "F", "M", "F", "M"),
Age = c(178, 251, 118, 490, 231, 171, 211, 621),
Height = c(3.80, 3.50, 3.10, 4.00, 4.10, 3.70, 3.20, 4.00),
Weight = c(100, 96, 88, 113, 92, 101, 94, 112)
)
}
},ignoreNULL = T)
observe({
updateSelectizeInput(session, "Names", choices = character_data()$Name)
})
output$Height_Weight_plot <- renderPlotly({
p <- plot_ly(character_data(),
x = ~Height,
y = ~Weight,
type = "scatter",
mode = "markers",
hoverinfo = "text",
hovertext = ~paste("Name: ",Name,
"\nRole: ",Role,
"\nAge: ",Age,
"\nHeight: ",Height,
"\nWight: ",Weight))
print(p)
})
observe({
if(length(input$Names) != 0){
character_data_sub <- character_data() %>% dplyr::filter(Name %in% input$Names)
plotlyProxy("Height_Weight_plot", session) %>%
plotlyProxyInvoke(
"relayout",
list(
annotations = list(x = character_data_sub$Height,
y = character_data_sub$Weight,
text = character_data_sub$Name,
xref = "x",
yref = "y",
showarrow = T,
arrowhead = 7,
ax = 20,
ay = -40)
)
)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
最佳答案
多年来我一直在同一问题上苦苦挣扎，我希望这对您自己和其他可能有同样问题的人有所帮助。
我不确定这是否一定是最漂亮的修复，但本质上我只能通过定义一个创建注释定义(列表)递归列表的函数来重新布局以绘制注释。换句话说:包含定义每个所需 Plotly 注释的各个单独列表的列表(每个列表类似于 Python 字典)。
希望一切都有意义!
library(shiny)
library(shinyjs)
library(plotly)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(inputId = "Race", label = "Race", choices = c("Humans", "Goblins"), selected = "Humans"),
actionButton(inputId = "Go", label = "Plot")
),
mainPanel(
plotlyOutput(outputId = "Height_Weight_plot"),
selectizeInput(inputId = "Names", label = "Search for characters", choices = NULL, multiple = TRUE)
)
)
)
server <- function(input, output, session) {
character_data <- eventReactive(input$Go,{
if(input$Race == "Humans"){
data.frame(
Name = c("Arthur", "Rodrick", "Elaine", "Katherine", "Gunther", "Samuel", "Marcus", "Selene"),
Role = c("Nobleman", "Soldier", "Soldier", "Priestess", "Mage", "Squire", "Merchant", "Witch"),
Sex = c("M", "M", "F", "F", "M", "M", "M", "F"),
Age = c(39, 41, 29, 46, 55, 17, 42, 40),
Height = c(6.00, 5.10, 5.80, 5.20, 6.30, 5.10, 5.40, 6.20),
Weight = c(160, 165, 154, 129, 171, 144, 131, 144)
)
}else if(input$Race == "Goblins"){
data.frame(
Name = c("Grog", "Dirk", "Kane", "Yilde", "Moldred", "Vizir", "Igret", "Baelon"),
Role = c("Pirate", "Pirate", "Pirate", "Bandit", "Merchant", "Bandit", "Merchant", "Shaman"),
Sex = c("M", "M", "M", "F", "F", "M", "F", "M"),
Age = c(178, 251, 118, 490, 231, 171, 211, 621),
Height = c(3.80, 3.50, 3.10, 4.00, 4.10, 3.70, 3.20, 4.00),
Weight = c(100, 96, 88, 113, 92, 101, 94, 112)
)
}
},ignoreNULL = T)
observe({
updateSelectizeInput(session, "Names", choices = character_data()$Name)
})
##function that creates plotly dictionary object for single annotation
listify_func <- function(x, y, text){
return(list(
x = x,
y = y,
text = as.character(text),
xref = "x",
yref = "y",
showarrow = TRUE,
arrowhead = 7,
arrowcolor = "#ff9900",
font = list(color = "#000000", size = 10),
ax = runif(1, 1, 90),
ay = -runif(1, 1, 90),
bgcolor = "#f5f5f5",
bordercolor = "#b3b3b3"
))
}
##creating reactive object containing the subsetted data:
highlighted <- eventReactive(input$Names,{
character_data_sub <- character_data() %>% dplyr::filter(Name %in% input$Names)
})
##creating a recursive list of annotation lists for selected genes
annotation_list <- reactiveValues(data = NULL)
observeEvent(input$Names,{
x <- highlighted()$Height
y <- highlighted()$Weight
text <- highlighted()$Name
##create dataframe with relative x, y and text values to create
##annotations:
df <- data.frame(x = x, y = y, text = text)
##create matrix of lists defining each annotation
ma <- mapply(listify_func, df$x, df$y, df$text)
if(length(ma) > 0){
##convert matrix to list of lists:
annotation_list$data <- lapply(seq_len(ncol(ma)), function(i) ma[,i])
}
})
##if nothing is selected, clear recursive list (i.e. remove annotations):
observe({
if(is.null(input$Names)){
annotation_list$data <- list()
}
})
output$Height_Weight_plot <- renderPlotly({
p <- plot_ly(character_data(),
x = ~Height,
y = ~Weight,
type = "scatter",
mode = "markers",
hoverinfo = "text",
hovertext = ~paste("Name: ",Name,
"\nRole: ",Role,
"\nAge: ",Age,
"\nHeight: ",Height,
"\nWight: ",Weight))
})
##proxy updating recursive list for annotations
observeEvent(annotation_list$data,{
plotlyProxy("Height_Weight_plot", session) %>%
plotlyProxyInvoke(
"relayout",
list(annotations = annotation_list$data)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
关于r - 如何使用 R Shiny 中的plotly proxy 将文本注释添加到绘图中，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/66672677/