複数のインタラクティブなドロップダウンメニューを使用したプロットトレースの可視性R

Question

表示されるデータを指定するいくつかのドロップダウンメニューがあります。

光沢を使って、選択した条件値をすべて個別に渡して、それに応じてデータセットをフィルタリングします。

次の例では光沢のない同じ機能を得ることはできますか？特に

library(plotly) 
means = c(0,1,10) 
scales = c(1,5) 

sample.size = 100 

t.visible = rep(F,2*length(means)*length(scales)) 
t.buttons = list() 

pl = plot_ly() 

for(i in 1:length(means)){ 
    for(j in 1:length(scales)){ 

    tt.visible = (i==1)&(j==1) 

    pl = pl %>% 
      add_trace(x=0:sample.size,y=c(0,cumsum(means[i]+scales[j]*rnorm(sample.size))),type='scatter',mode='lines',color='one', visible = tt.visible) %>% 
      add_trace(x=0:sample.size,y=c(0,cumsum(means[i]+scales[j]*rt(sample.size,df=5))),type='scatter',mode='lines',color='two',visible = tt.visible) 

    tt.visible = t.visible 
    tt.visible[(i-1)*length(scales)*2+(j-1)*2+(1:2)] = T 

    t.buttons[[(i-1)*length(scales)+j]] = list(
     method = 'update', 
     args = list(list(visible = tt.visible), 
        list(title = paste0('mean = ',means[i],'; scale = ',scales[j]))), 
     label = paste0('mean = ',means[i],'; scale = ',scales[j]) 
    ) 
    } 
} 

pl = pl %>% layout(
    title = paste0('mean = ',means[1],'; scale = ',scales[1]), 
    xaxis = list(title='time'), 
    yaxis = list(title='value'), 
    updatemenus = list(list(active = 0, 
          buttons = t.buttons)) 
) 

、二つの別々の（相互作用）ボタン、ための1つが、スケールベクトルのベクトルと一つの手段を持っている方法はありますか？

Answer 1

独自のドロップダウンを作成し、少しのJavaScriptを使用すると、トレースを動的に表示および非表示にすることができます。

• 選択

に基づいてPlotlyデータのvisibleを設定し、両方のメニューへeventlistener

を追加動的に入力配列

に基づいてドロップドラウンメニューを作成します。 htmlwidgetsを使用する場合、Plotlyグラフを含むdivが引数として渡されます（この例では）。データはdata属性にあります。

library(plotly) 
library(htmlwidgets) 

means = c(0,1,10) 
scales = c(1,5) 
sample.size = 100 

pl = plot_ly() 

for(i in 1:length(means)){ 
    for(j in 1:length(scales)){ 
    trace_name <- paste('means:', means[i], '; scale:', scales[j]) 
    pl = pl %>% 
     add_trace(x=0:sample.size, 
       y=c(0,cumsum(means[i]+scales[j]*rnorm(sample.size))), 
       type='scatter', 
       mode='lines', 
       color='one', 
       mode='line', 
       visible = (i==1)&(j==1), 
       name = trace_name) %>% 
     add_trace(x=0:sample.size, 
       y=c(0,cumsum(means[i]+scales[j]*rt(sample.size,df=5))), 
       type='scatter', 
       mode='lines', 
       color='two', 
       visible = (i==1)&(j==1), 
       name = trace_name) 
    } 
} 

javascript <- " 
var select_mean = document.createElement('select'); 
select_mean.id = 'mean'; 
var select_scale = document.createElement('select'); 
select_scale.id = 'scale'; 
el.append(document.createTextNode('Means')); 
el.append(select_mean); 
el.append(document.createTextNode('Scale')); 
el.append(select_scale); 
function showTraces() { 
    var select_scale = document.getElementById('scale'); 
    var select_mean = document.getElementById('mean'); 
    var scale = select_scale.options[select_scale.selectedIndex].text; 
    var mean = select_mean.options[select_mean.selectedIndex].text; 
    var traceName = 'means: ' + mean + ' ; ' + 'scale: ' + scale; 
    for (var i = 0; i < el.data.length; i += 1) { 
    el.data[i].visible = el.data[i].name.indexOf(traceName) > -1 
    } 
    Plotly.redraw(el) 
} 
select_scale.addEventListener('change', function() { 
    showTraces(); 
}); 
select_mean.addEventListener('change', function() { 
    showTraces(); 
}); 
" 
for(i in 1:length(means)){ 
    javascript <- paste(javascript, " 
var option = document.createElement('option'); 
option.text = '", means[i], "'; 
select_mean.append(option);", sep='') 
} 

for(j in 1:length(scales)) { 
    javascript <- paste(javascript, " 
var option = document.createElement('option'); 
option.text = '", scales[j], "'; 
select_scale.append(option);", sep='') 
} 

w <- as_widget(pl) 
w <- htmlwidgets::onRender(w, paste("function(el, x, data) {", javascript, "}"), data=list('a', 'b')) 
htmlwidgets::saveWidget(w, "buttons.html") 
w