ブラウザからプロットされたデータポイントを強調表示/見つけ出す

Question

プロットと汎用データフレームを使用して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="")) 

Answer 1

私はPlotlyにおける組み込み機能はありません知っているが、あなただけの機能を取得するにはJavascriptのコードの数行を必要として。

HTMLファイルのapplication/jsonオブジェクトにデータをプロットして保存します。あなたはiは、トレース番号であるとjは、ポイント数である

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

に

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

テキスト要素が格納されているを介してデータを取得することができます。

今、私たちは、テキストフィールドやボタンを必要とする、我々は

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

はのは、最初のトレースの最初のポイントのhover eventをトリガーボタンにeventlisterを追加してみましょう、その目的のためにhtmltoolsを使用することができます。

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}]); 
    } 
) 
')))  

そして、すべてのテキストラベル通じを検索し、入力したテキストをラベルで発見されたときにホバーイベントをトリガし、全体のコード。

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から変更されました。