R：向 Plotly 添加搜索栏

Question

我在这里找到了这篇 stackoverflow 帖子（在浏览器中突出显示/查找散点图中的数据点），其中展示了如何为散点图中的散点图创建搜索栏。

我尝试运行此示例中提供的代码：

library(plotly)
library(htmlwidgets)
library(htmltools)

pcaCars <- princomp(mtcars, cor = TRUE)
carsHC <- hclust(dist(pcaCars$scores), method = "ward.D2")

carsDf <- data.frame(pcaCars$scores, "cluster" = factor(carsClusters))
carsClusters <- cutree(carsHC, k = 3)

carsDf <- transform(carsDf, cluster_name = paste("Cluster", carsClusters))

p <- plot_ly(carsDf, x = ~Comp.1 , y = ~Comp.2, text = rownames(carsDf),
             mode = "markers", color = ~cluster_name, marker = list(size = 11), type = 'scatter', mode = 'markers')

p <- htmlwidgets::appendContent(p, htmltools::tags$input(id='inputText', value='Merc', ''), htmltools::tags$button(id='buttonSearch', 'Search'))
p <- htmlwidgets::appendContent(p, htmltools::tags$script(HTML(
  'document.getElementById("buttonSearch").addEventListener("click", function()
    {        
      var i = 0;
     var j = 0;
      var found = [];
      var myDiv = document.getElementsByClassName("js-plotly-plot")[0]
      var data = JSON.parse(document.querySelectorAll("script[type=\'application/json\']")[0].innerHTML);
      for (i = 0 ;i < data.x.data.length; i += 1) {
        for (j = 0; j < data.x.data[i].text.length; j += 1) {
          if (data.x.data[i].text[j].indexOf(document.getElementById("inputText").value) !== -1) {
            found.push({curveNumber: i, pointNumber: j});
          }
        }
      }
      Plotly.Fx.hover(myDiv, found);
    }  
  );')))                                                    

htmlwidgets::saveWidget(p, paste('pca', ".html", sep=""))
p

该代码似乎可以运行，但我没有看到搜索栏：

有人可以告诉我我做错了什么以及如何解决这个问题吗？

谢谢！

Answer 1

另存为 HTML

使用 Crosstalk 时，最简单的途径可能是通过 RStudio 中的查看器窗格导出。

添加重置按钮；多项选择；减小搜索栏大小

重置按钮：要添加重置选项，您需要一点 JS。（我稍后会回来讨论这一点。）

多项选择：要设置此项以便从下拉列表中选择一项或多项，请在调用 filter_select 时将参数更改multiple = F为T。

搜索栏宽度：可以通过 R 代码或 JS 设置搜索栏的宽度。widths对于 R，使用函数中的参数bscols。为每个项目设置宽度。完整宽度始终为 12，因此如果您希望搜索栏为绘图宽度的一半，但您想要两行，则可以使用width = c(6, 12). widths（如果您的总数超过 12，您将会收到警告。不过，这只是一个警告。）

所有这些示例均假设 IDfilter_select为lantern。如果你在这个函数里改的话，那么到处都得改。

question_filter <- crosstalk::filter_select(
  "lantern", "Select a group to examine",
  sd, ~filterBy, multiple = T
)

最简单的变化

这是很简单的，但可以实现你想要的。

这需要图书馆htmltools。

bscols(widths = c(6, 6, 12),
       question_filter, 
       div(id = "yayButtons",
           tags$script(HTML(
             "setTimeout(function(){ 
             $('#yayButtons').append(         /* create and add button */
             '<button class=\"forStylin\" type=\"button\"' +
             'onClick=\"window.location.reload()\">' +  /* reset action */
             'Click Me to Reset Plot</button>');
             }, 10)"))),
       plot)

备用搜索栏宽度设置

如果你想用 JS 设置搜索栏的宽度，你可以用htmlwidgets::onRender. 您也可以将其添加到setTimeout中间的函数中。这是一个附加在绘图上的示例（只是为了更容易看到它）。

bscols(widths = c(6, 6, 12),
       question_filter, 
       div(id = "yayButtons",
           tags$script(HTML(
             "setTimeout(function(){
             $('#yayButtons').append(         /* create and add button */
             '<button class=\"forStylin\" type=\"button\"' +
             'onClick=\"window.location.reload()\">' + /* reset action */
             'Click Me to Reset Plot</button>');
             }, 10)"))),
       plot %>% htmlwidgets::onRender(
         "function(){
         gimme = document.getElementById('lantern');
         gimme.style.width = '25%';       /* too small, but you get the point */
         }"))

为重置按钮添加样式

我知道如果我有一个按钮和一个搜索栏，我希望它们的外观至少有些相似。这是第一个版本的更复杂的变体。这个为重置按钮添加了样式。我添加了很多东西，以便您可以看到一些选项。

bscols(widths = c(6, 6, 12),
       question_filter, 
       div(id = "yayButtons",
           tags$script(HTML(
             "setTimeout(function(){
             $('#yayButtons').append(          /* create and add button */
             '<button class=\"forStylin\" type=\"button\"' +
             'onClick=\"window.location.reload()\">' + /* reset action */
             'Click Me to Reset Plot</button>');
             }, 10)")),
           tags$style(HTML(
             "div#yayButtons {     /* this centers the button in its area */
             display: flex;
             justify-content: center;
             }
             .forStylin {
             font-size: 1rem;    /* from input bar */
             font-family: times; /* from input bar */
             margin-top: 1rem;   /* inline with dropdown box */
             min-height: 34px;   /* attr of input box */
             background-color: rgb(31, 119, 180); /* plotly point color */
             color: white;
             }"
           ))),
       plot)

Answer 2

我从这里改编了答案，得到了更接近我想要的东西：

library(plotly)
library(crosstalk)


dat <- tibble::tribble(~filterBy, ~x, ~y,
                       "a", 1, 1,
                       "b", 2, 1,
                       "a", 1, 2,
                       "b", 2, 2,
                       "a", 1, 3,
                       "b", 2, 3,
                       "a", 1, 2,
                       "b", 2, 3,
                       "c", 3, 1,
                       "c", 3, 2,
                       "c", 3, 3
)  


dat = data.frame(filterBy = 1:100, x = rnorm(100,100,100), y = rnorm(100,100,100))

sd <- SharedData$new(dat)

question_filter <- crosstalk::filter_select(
    "lantern", "Select a group to examine",
    sd, ~filterBy, multiple = F)  # <---- data changed to shared data


# Plotting:
plot <-  plot_ly(sd,  # <---- data changed to shared data
                 x = ~x, y = ~y, text = ~filterBy,  mode = "markers+text", 
                 textposition = "top", hoverinfo = "x+y")

plot
bscols(plot, question_filter) # combine crosstalk elements

仍然存在一些问题：

• 这个输出可以保存为 HTML 文件吗？
• 是否可以添加“重置按钮”？（例如，当我选择一个点时，无法返回查看所有点）
• 是否可以选择多个点？
• 是否可以减小搜索栏的大小？