Aga
Aga

Reputation: 89

Visibility of plotly traces using multiple interacting dropdown menus in R

I'd like to have several dropdown menus which specify which data are showed.

Using shiny I can pass all the selected conditioning values separately and then filter the data set based on their interactions accordingly.

Is it possible to obtain the same functionality without shiny in the following example?

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))
)

In particular, is there a way to have two separate (interacting) buttons, one for the means vector and one for the scales vector?

Upvotes: 2

Views: 1355

Answers (1)

Maximilian Peters
Maximilian Peters

Reputation: 31679

You could create your own drop downs and with a little bit of JavaScript dynamically show and hide traces.

  • Create drop drown menus dynamically based on your input arrays
  • Add an eventlistener to both menus
  • Set the visible of the Plotly data based on the selection

enter image description here

When using htmlwidgets the div which contains the Plotly graph is passed as an argument (el in this example). The data can be found in the data attribute.

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

Upvotes: 2

Related Questions