Reputation: 89
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
Reputation: 31679
You could create your own drop downs and with a little bit of JavaScript dynamically show and hide traces.
eventlistener
to both menusvisible
of the Plotly data based on the selectionWhen 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