从浏览器中突出显示/查找数据点

时间:2017-02-28 11:08:06

标签: r plotly scatter

我使用plotly和通用数据框生成HTML格式的散点图。我知道在生成绘图HTML之前,可以突出显示(例如,使用不同的颜色)某些数据点。但是,我想知道是否可以在HTML文件中添加一个元素,使用户能够在生成绘图后根据文本标签查找/突出显示某个数据点。

我用来生成数据框和分散的代码:

tab <- data.frame(sample.id = pca$sample.id,
                  EV1 = pca$eigenvect[, 1],
                  EV2 = pca$eigenvect[, 2],
                  stringsAsFactors=F)

p <- plot_ly(tab, x=tab$EV1, y=tab$EV2, text=tab$sample.id)
p <- layout(p, title="PCA", xaxis=list(title="PC 1"),
          yaxis=list(title="PC 2"))

htmlwidgets::saveWidget(as.widget(p), paste(output_name, ".html", sep=""))

1 个答案:

答案 0 :(得分:3)

据我所知,Plotly中没有内置功能,但您只需要几行Javascript代码即可获得功能。

将数据存储在HTML文件中的application/json对象中。您可以通过

获取数据
var data = JSON.parse(document.querySelectorAll("script[type='application/json']")[0].innerHTML);

文本元素存储在

data.x.data[i].text[j]

其中i是跟踪号,j是点号。

现在我们需要一个文本字段和一个按钮,我们可以将htmltools用于此目的

p <- htmlwidgets::appendContent(p, htmltools::tags$input(id='inputText', value='Merc', ''), htmltools::tags$button(id='buttonSearch', 'Search'))

让我们在按钮上添加一个事件列表,触发第一个跟踪的第一个点的hover event

p <- htmlwidgets::appendContent(p, htmltools::tags$script(HTML(
  'document.getElementById("buttonSearch").addEventListener("click", function() 
    {
    var myDiv = document.getElementsByClassName("js-plotly-plot")[0]
    Plotly.Fx.hover(myDiv, [{curveNumber: 0, pointNumber: 0}]);
    }
  )
')))    

整个代码搜索所有文本标签,并在标签中找到输入的文本时触发悬停事件。

enter image description here

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

PCA实施已从here修改。