为什么 shiny App 使用高亮功能和 selectize=TRUE 向 Plotly 图表添加虚假小部件？

Question

我用 ggplotly 制作了一个图表来显示 10 名参与者在三个测试中取得的结果。该图显示了按实验分组的散点图（个体参与者）和汇总统计数据（箱线图）。我添加了一个将 selectize 设置为 TRUE 的突出显示功能，以便用户可以在 filter_select 框中搜索特定参与者并在图表上突出显示参与者的结果。

当我运行没有闪亮的代码时，我得到了预期的结果，即上面带有 filter_select 框的图表，用于搜索参与者。但是当我在闪亮的应用程序中渲染 Plotly 图形时，我得到了一个额外的小部件，它似乎没有做任何事情但确实混淆了布局（运行下面的 Shiny App 代码可以看到效果）。

library(shiny)
library(plotly)
library(shinyWidgets)

dataset <- tibble(Name=rep(LETTERS[1:10],3),Result=sample(100,30),
                  Experiment=c(rep("T1",10),rep("T2",10),rep("T3",10)))

ui <- fluidPage(
  fluidRow(
       column(width = 10, offset = 1,
              plotlyOutput("graph")
       )
  )
)

server <- function(input, output, session) {

output$graph <- renderPlotly({

d <- highlight_key(dataset,~Name,group="Select participant")

p <- ggplot(d,aes(Experiment,Result,fill=Experiment,text=paste0("<b>Name: ",
                                          Name,"</b><br />Result: ",Result,"%"))) +
  geom_boxplot()+
  geom_point(size=2,position=position_jitterdodge(dodge.width = 0.4)#,
  )+ggtitle("Results by Experiment (all subjects)")+
  theme(legend.position="none",axis.text.x=element_text(size=15),
                 axis.title.x=element_text(color="red",size=15))

p <- ggplotly(p,tooltip=c("text"))

p <- style(p,hoverlabel=list(bgcolor="white",bordercolor="black",font="Arial"))

highlight(p,on="plotly_click",off="plotly_doubleclick",selectize=TRUE,color="green")
})
}

shinyApp(ui, server)

我想从 plotlyOutput 中删除这个虚假的小部件；我浏览了关于 shiny-plotly-highlight 主题的大量问题和答案，但 none 遇到了与我遇到的问题类似的问题。我想知道是否有人遇到过这个问题并找到了解决方案。非常感谢对此的任何帮助。

Answer 1

看起来像一个错误。您可以像这样隐藏此小部件：

ui <- fluidPage(
  fluidRow(
    column(width = 10, offset = 1,
           plotlyOutput("graph")
    )
  ),
  tags$script(
    "setTimeout(function(){$('#graph').prev().children()[1].style.display = 'none';}, 500);"
  )
)

编辑

这里有一个更好的解决方案：

js <- '
$(document).on("shiny:value", function(e){
  if(e.name === "graph"){
    setTimeout(function(){
      $("#graph").prev().children()[1].style.display = "none";
    }, 0);
  }
});
'

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  fluidRow(
    column(width = 10, offset = 1,
           plotlyOutput("graph")
    )
  )
)

Answer 2

@StéphaneLaurent @IqbalAdijali 非常感谢！你是最棒的！我一直在寻找解决方案。在这一刻之后，你启发了我学习 java 脚本。

我会为其他想要实现上述 JS 代码的人添加 - 我将它粘贴到 tabPanel 中的 UI 中，就像这样（不要忘记更改情节名称！”图表”，或在本例中为“plot_15”，到您的地块名称):

tags$head(tags$script(HTML(
'
$(document).on("shiny:value", function(e){
if(e.name === "plot_15"){
setTimeout(function(){
$("#plot_15").prev().children()[1].style.display = "none";
}, 0);
}
});
'
))

此外，您可能需要分别添加逗号或括号来分隔表达式或关闭语句。

为什么 shiny App 使用高亮功能和 selectize=TRUE 向 Plotly 图表添加虚假小部件？

Why does shiny App add a spurious widget to a Plotly graph using highlight function and selectize=TRUE?

r

highlight

shiny

plotly

htmlwidgets

编辑